home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / twu1.zip / TWU1UAM.PAS < prev    next >
Pascal/Delphi Source File  |  1991-06-03  |  70KB  |  2,045 lines
  1. {$D+,L+,O-,S+,R-}
  2.  
  3. { This Unit provides the tools needed for high-level analysis }
  4. { of desired units by the main program (TWU1).  It is object  }
  5. { oriented in its implementation but not in its interface.    }
  6. { The intended user of this unit has relatively simple needs  }
  7. { and no additional capabilities are provided.  In particular }
  8. { the details of implementation including data structures are }
  9. { hidden from any potential user.  The object methodology is  }
  10. { not very spiritual.  Neither inheritance nor virtual method }
  11. { techniques are employed, but static objects are utilized to }
  12. { assist with data management on the heap providing a highly  }
  13. { structured environment for implementation.              }
  14.  
  15. Unit TWU1UAM;
  16.  
  17. (*****************)
  18. (**) INTERFACE (**)    Uses TWU1EQU, TWU1RPT, Dos;
  19. (*****************)
  20.  
  21. CONST
  22.  
  23.   _UnitEye  = 'TPU9';        { Identifies Units For TP60, TPW10    }
  24.   _Win_Lib  = 'TPW.TPL';    { Turbo Pascal Unit Library - WINDOWS }
  25.   _Dos_Lib  = 'TURBO.TPL';    { Turbo Pascal Unit Library - DOS     }
  26.    Masker   = $FFFFFFF0;    { Paragraph AND Mask              }
  27.  
  28.   _Lib_Nam  : _FileSpec = _Win_Lib;    { Default to Windows Library  }
  29.  
  30.                 { Call Model Flag Bits     }
  31.   Sstb_cmASM          = $80;    { Call Model: ASSEMBLER    }
  32.   Sstb_cmDestructor  = $50;    { Call Model: DESTRUCTOR   }
  33.   Sstb_cmConstructor = $30;    { Call Model: CONSTRUCTOR  }
  34.   Sstb_cmMethod      = $10;    { Call Model: METHOD- any  }
  35.   Sstb_cmObject         = $08;    { $L OBJECT Mod (OBJ/OBW)  }
  36.   Sstb_cmInterrupt   = $04;    { INTERRUPT Routine        }
  37.   Sstb_cmINLINE         = $02;    { INLINE Declarative Macro }
  38.   Sstb_cmFAR         = $01;    { Call Model: FAR       }
  39.  
  40. VAR    Base_Code,         { Logical Load Address for CODE Segments }
  41.     Base_Data,        { Logical Load Address for CONS Segments }
  42.     Base_FixC,        { Logical Load Address for CODE Fix-Ups     }
  43.     Base_FixD: LongInt;    { Logical Load Address for CONS Fix-Ups  }
  44.  
  45. TYPE
  46.     _UnitName = String[8];    { Max Size of a Unit Name      }
  47.     _LexName  = String[63];    { Max Size of Pascal Names     }
  48.     SrcNam    = _FileSpec;
  49.  
  50.     HdrAry    = ARRAY[0..3] OF Char;
  51.  
  52.     LL  = Word;        { Local Scope Locators (offsets) }
  53.  
  54.   LG  = RECORD        { --Global Scope Locators to Other Units-- }
  55.     UntLL: LL;    { To Entry in Unit Named by Type "Y" Entry }
  56.         UntId: LL;    { To Stub of Type "Y" Name Entry        }
  57.   END;  {LG}
  58.  
  59.   { Mapping for Unit Header and Locator Table }            {.CP28}
  60.  
  61. UnitPtr = ^UnitHeader;
  62. UnitHeader = RECORD
  63.     UHEYE : HdrAry;        { +00 : = 'TPU9'                     }
  64.     UHxxx : HdrAry;        { +04 : = $00000000                  }
  65.     UHUDH : LL;        { +08 : to DName Entry for This Unit }
  66.     UHIHT : LL;        { +0A : to Interface Hash Header     }
  67.     UHPMT : LL;        { +0C : to PROC Map                  }
  68.     UHCMT : LL;        { +0E : to CSeg Map                  }
  69.     UHTMT : LL;        { +10 : to DSeg Map-Typed CONST's    }
  70.     UHDMT : LL;        { +12 : to DSeg Map-GLOBAL Variables }
  71.     UHDLL : LL;        { +14 : to DLL Module List           }
  72.     UHLDU : LL;        { +16 : to Donor Unit List           }
  73.     UHLSF : LL;        { +18 : to Source File List          }
  74.     UHDBT : LL;        { +1A : DEBUG Trace Table            }
  75.     UHZDA : Word;        { +1C : Size of DICTIONARY Area      }
  76.     UHZCS : Word;        { +1E : CSEG Size-Aggregate          }
  77.     UHZDT : Word;        { +20 : DSEG Size-Typed CONSTS Only  }
  78.     UHZFA : Word;        { +22 : Fix-Up Size (CSegs)          }
  79.     UHZFT : Word;        { +24 : Fix-Up Size (Typed CONST's)  }
  80.     UHZFV : Word;        { +26 : DSEG Size for Global VARs    }
  81.     UHDHT : LL;        { +28 : to Global Hash Header        }
  82.     UHSOV : Word;        { +2A : Flags ??                 }
  83.     UHPad : ARRAY[0..9]
  84.         OF Word;    { +2C : Reserved for Future Expansion ? }
  85.  
  86. END; { UnitHeader }
  87.  
  88.   { Mapping for PROC Map }                    {.CP12}
  89.  
  90.   PMapRecPtr  = ^PMapRec;
  91.   PMapRec = RECORD
  92.     ProcWd1,       { purpose is unknown            }
  93.     ProcWd2 : Word; { contains proc attribute flags?        }
  94.     CSegOfs : Word;    { offset within CSeg Map; $FFFF if null }
  95.     CSegJmp : Word;    { offset to entry point;  $FFFF if null }
  96.   END {PMapRec};
  97.  
  98.   PMapPtr = ^PMapTab;
  99.   PMapTab =  ARRAY[0..1] OF PMapRec; { model of PROC Map }
  100.  
  101.   { Mapping for CSeg Map }                    {.CP12}
  102.  
  103.   CMapRecPtr = ^CMapRec;
  104.   CMapRec = RECORD
  105.     CSegWd0,    { purpose is unknown              }
  106.     CSegCnt,    { byte count of module code       }
  107.     CSegRel,    { byte count of module Relo List  }
  108.     CSegTrc : Word;    { Trace table offset or $FFFF     }
  109.   END; {CMapRec}
  110.  
  111.   CMapTabPtr = ^CMapTab;
  112.   CMapTab = ARRAY[0..1] OF CMapRec; { model of CSeg Map }
  113.  
  114.   { Mapping for CONST/VAR DSeg Maps }                {.cp12}
  115.  
  116.   DMapRecPtr = ^DMapRec;
  117.   DMapRec = RECORD
  118.     DSegWd0 : Word;    { purpose is unknown        }
  119.     DSegCnt : Word;    { byte count of DSeg block    }
  120.     DSegRel : Word;    { byte count of DSeg Relo List    }
  121.     DSegOwn : LL;    { To owner scope (VMT/DMT)    }
  122.   END; {DMapRec}
  123.  
  124.   DMapTabPtr = ^DMapTab;
  125.   DMapTab = ARRAY[0..1] OF DMapRec;    { model of DSeg Map }
  126.  
  127.   { One Entry in CODE/DATA Fix-Up List }            {.CP29}
  128.  
  129.   FixUpRecPtr = ^FixUpRec;
  130.   FixUpRec = RECORD
  131.     Case Word Of
  132.     0:       { -- Smart Linker Fix-Ups (Windows/Dos) -- }
  133.        (
  134.        FixDnr : Byte;    { Donor Unit Offset        }
  135.        FixFlg : Byte;    { Entry Format Flag        }
  136.        FixWd1 : Word;    { Offset to Map Table        }
  137.        FixWd2 : Word;    { Effective Address Adjuster    }
  138.        FixOfs : Word;    { offset to patch in text block }
  139.        );
  140.     $FFFF:    { -- Loader Fix-Ups For Windows 8087 Emulator -- }
  141.        (
  142.        EmuTag : Word;    { $FFFF flags Emulator Fix-Up    }
  143.        EmuTyp : Word;      { Specific Emulator Fix-Up Type    }
  144.           { 2 = SS Override - (INT 3Ch : "ESC" = 18-1F)    }
  145.           { 3 = CS Override - (INT 3Ch : "ESC" = 58-5F)    }
  146.           { 4 = ES Override - (INT 3Ch : "ESC" = D8-DF)    }
  147.           { 5 = NO Override - (INT 34-3Bh : D8-DF)    }
  148.           { 6 = Emulate FWAIT Op ($909B) - (INT 3Dh)    }
  149.        EmuEmt : Word;  { Probably always zero         }
  150.        EmuOfs : Word;  { Offset to start of Emulated Op     }
  151.        );
  152.   END; {FixUpRec}
  153.  
  154.   FixUpPtr  = ^FixUpList;
  155.   FixUpList = ARRAY[0..1] OF FixUpRec;    { model of Fix-Up List }
  156.  
  157.   { Dictionary Name Entry Mapping in Turbo Units }        {.CP08}
  158.  
  159.   DNamePtr = ^ DNameRec;
  160.   DNameRec = RECORD
  161.     HLink : LL;        { Hash Chain Link; Resolves Collisions }
  162.     DForm : Char;        { Symbol Type; See StubRecord for types}
  163.     DSymb : _LexName;   { Worst-Case Symbol Size (UPPER-CASE)  }
  164.   END; {DNameRec}
  165.  
  166.   { Variant Type For TYPE "R" Dictionary Entry Stubs }        {.CP20}
  167.  
  168.   VarStubPtr = ^VarStub;
  169.   VarStub    = RECORD
  170.     Case  Byte Of        { sRAM Byte in Type "R" Stub }
  171.          $02,$06,
  172.          $22,$26:    (ROfs : Word;  { allocation offset (BP)  }
  173.              ROB  : Word); { To Parent Scope/Zero    }
  174.  
  175.          $00,$01:    (TOfs : Word;  { allocation offset in map}
  176.              TOB  : LL);   { offset in VAR/CONST Map }
  177.  
  178.          $03:    (AOfs : Word;  { Absolute Byte Offset    }
  179.              ASeg : Word); { Absolute Segment Adr    }
  180.  
  181.          $08:    (Bofs : Word;  { Offset-Record Relative  }
  182.              RChn : LL);   { To Next Field/Method    }
  183.  
  184.          $10:    (QLG  : LG);   { to Stub of Allocator    }
  185.   End;
  186.  
  187.   { Dictionary Stub Mapping }                    {.CP10}
  188.  
  189.   DStubPtr = ^ DStubRcd;
  190.   DStubRcd = RECORD
  191.     CASE Char OF
  192.  
  193.       'R': (            { -- Variable, Field, Object  --  } {.CP35}
  194.         sRAM : Byte;        {   allocation method codes:      }
  195.                 { $00 = Global Variables in DS    }
  196.                 { $01 = Typed Constants  in DS    }
  197.                 { $02 = VAR-BP based-Nested Scope }
  198.                 { $03 = Absolute[Segment:Offset]  }
  199.                 { $06 = SELF Parameter-ADDR Stack }
  200.                 { $08 = Allocate in Record/Object }
  201.                 { $10 = Absolute Equivalence      }
  202.                 { $22 = VALUE Parameter-BP based  }
  203.                 { $26 = VAR   Parameter-BP based  }
  204.  
  205.         sRVF : VarStub;    { Don't have UNION - see Above!   }
  206.         sRTD : LG);        { to Type Descriptor              }
  207.  
  208.       'S': (            { ------ User Subprograms ----- }  {.CP20}
  209.         sSTp : BYte;    { 76543210  - BIT Encoded Flags }
  210.                 { .......1 = FAR Call Model     }
  211.                 { ......1. = INLINE Declarative }
  212.                 { .....1.. = INTERRUPT Routine  }
  213.                 { ....1... = .OBJ module code   }
  214.                 { ...1.... = METHOD (Any)       }
  215.                 { .011.... = Constructor METHOD }
  216.                 { .101.... = Destructor  METHOD }
  217.                 { 1....... = ASSEMBLER attribute}
  218.         sSxx : Byte;    { More Attribute Flags?        }
  219.         sSPM : Word;    { Code byte count if INLINE,    }
  220.                 { else, offset to PROC Map    }
  221.         sSPS : LL;        { to containing scope or zero    }
  222.         sSHT : LL;        { to local scope hash table    }
  223.         sSVM : Word);    { VMT Offset-VIRTUAL Method PTR    }
  224.  
  225.         { Note:  "sSVM" is followed immediately by a Type    }
  226.         {        Descriptor ($06).  INLINE Declarative code  }
  227.         {        Bytes then follow (if any).                 }
  228.  
  229.       'Q',            { -------- Named Types -------- }  {.CP03}
  230.       'X':(            { ----- External Variables ---- }
  231.        sQTD : LG);        { to type descriptor            }
  232.  
  233.  
  234.       'P':(            { --- For Untyped Constants --- }
  235.        sPTD : LG;        { to type descriptor            }
  236.        sPV1 : Word;        { value of constant - LO Word   }
  237.        sPV2 : Word);    { (size varies)     - HI Word   }
  238.  
  239.       'Y':(            { ----- For UNIT Entries ------ }  {.CP05}
  240.        sYW1 : Word;        { unknown use; normally zero    }
  241.        sYCS : Word;        { Unit Version Number        }
  242.        sYNU : LL;        { to next Unit in List (SUCC)    }
  243.        sYPU : LL);        { to prior Unit in List (PRED)    }
  244.  
  245.       'O',            { ---- Label Declaratives ----- }  {.CP05}
  246.       'T',            { ---- Standard Procedures ---- }
  247.       'U',            { ---- Standard Functions  ---- }
  248.       'V':(            { ---- Standard "NEW" F/P  ---- }
  249.        sVxx : Word);    { semantics not precisely known }
  250.  
  251.       'W':(            { ------- Standard Ports ------ }  {.CP02}
  252.        sWxx : Byte);    { 0=Byte Array, 1=Word Array    }
  253.       END;
  254.  
  255.   { One Formal Parameter List Entry }                {.CP06}
  256.  
  257.   FormalParmRcd = RECORD
  258.        fPTD : LG;        { to type descriptor for parameter  }
  259.        fPAM : Byte;        { passing model; 2=Value, 6=Address }
  260.      END;
  261.  
  262.   InlineLst = ARRAY[0..1] OF Word;        { model of INLINE code }
  263.  
  264.  
  265.   { Type Descriptor mapping for Turbo Units follows }        {.CP08}
  266.  
  267.   TypePtr   = ^TypeRecd;
  268.   TypeRecd  = RECORD
  269.        tpTC : Byte;        { Identifies the Variant Part }
  270.        tpTQ : Byte;        { Type Qualifier              }
  271.        tpSW : Word;        { Storage Width in Bytes      }
  272.        tpML : Word;        { Next Method if tpTC=$06     }
  273.  
  274.        CASE Byte OF                        {.CP04}
  275.     $00,            { For NULL / Un-Typed Variables }
  276.     $0A,            { COMP,DOUBLE,EXTENDED,SINGLE     }
  277.     $0B: ();        { ------- For REAL Type ------- }
  278.  
  279.     $01: (            { ------ For ARRAY Types ------ }{.CP04}
  280.         BaseType: LG;    { to TypeRecd for item arrayed  }
  281.         BounDesc: LG;    { to TypeRecd for array bounds  }
  282.              );
  283.  
  284.     $02: (            { ------ For RECORD Types ------ }{.CP04}
  285.         RecdHash: LL;    { to Hash Table for Field List   }
  286.         RecdDict: LL;    { to Field List Dictionary Begin }
  287.              );
  288.  
  289.     $03: (            { ------ For OBJECT Types ------ }{.CP15}
  290.         ObjtHash: LL;    { to Fields & Methods Hash Table }
  291.         ObjtDict: LL;    { to Fields & Methods Dictionary }
  292.         ObjtOwnr: LG;    { to Parent Object Type Descript }
  293.         ObjtVMTs: Word;    { Size of VMT if Virtual Methods }
  294.         ObjtDMap: Word;    { Data Map Offset of VMT Template}
  295.         ObjtVMTO: Word;    { object instance offset to VMT  }
  296.                 { pointer; $FFFF if object has   }
  297.                 { no Virtual Methods (no VMT)    }
  298.         ObjtName: LL;    { to Object Dictionary Header    }
  299.         ObjtDMTp,    { $FFFF or DMap Offset of DMT    }
  300.         ObjtRes1,    { Usually zero  - Role Unknown   }
  301.         ObjtRes2,    { Usually zero  - Role Unknown   }
  302.         ObjtRes3: Word    { Usually zero  - Role Unknown   }
  303.              );
  304.  
  305.     $04,            { ----- For FILE except TEXT ----} {.CP04}
  306.     $05: (            { ----- For TEXT file type ----- }
  307.         FileType: LG;    { to TypeRecd for Base File Type }
  308.              );
  309.     $06: (            { ----- For Procedure Types ---- } {CP05}
  310.         PFRes: LG;    { to Function Result TD / zero   }
  311.         PNPrm: Word;    { Formal Parameter Count/ zero   }
  312.                 PFPar: ARRAY[1..2] OF FormalParmRcd { model only }
  313.              );
  314.     $07: (            { ------- For SET Types -------- } {.CP03}
  315.         SetBase: LG;    { to base type descriptor of set }
  316.              );
  317.     $08: (            { ----- For POINTER Types ------ } {.CP03}
  318.         PtrBase: LG;    { to base type descriptor        }
  319.              );
  320.     $09: (            { ------ For STRING Types ------ } {.CP04}
  321.         StrBase:  LG;    { to SYSTEM.CHAR type descriptor }
  322.         StrBound: LG;    { to array bounds for string typ }
  323.              );
  324.     $0C,        { For BYTE,INTEGER,LONGINT,SMALLINT,WORD } {.CP15}
  325.     $0D,            { ------ For BOOLEAN Type ------ }
  326.     $0E,            { ------- For CHAR Type -------- }
  327.     $0F: (            { ---- For Enumerated Types ---- }
  328.         LoBnd: LongInt;    { lower bound of subrange     }
  329.         HiBnd: LongInt;    { upper bound of subrange     }
  330.         Cmpat: LG;    { to upward compatible Type desc }
  331.          );
  332.  
  333.         { The Enumeration Type Descriptor is immediately }
  334.         { followed by a SET Type Descriptor ($07) but we }
  335.         { don't know what this achieves.  Its base type  }
  336.         { LG points to the Enumerated Type Descriptor.     }
  337.  
  338.        END;  { TypeRecd }
  339.  
  340.   { The Record below is a model Hash Table }            {.CP07}
  341.  
  342.   HashPtr   = ^HashTable;
  343.   HashTable = RECORD
  344.     Bas: Word;                { Base and Max Offset in Slt }
  345.     Slt: ARRAY[0..63] Of LL;  { Slots in Hash Table        }
  346.   END;
  347.  
  348.   { The Record below maps a DLL List Entry - TPW Only}        {.CP07}
  349.  
  350.   DLLPtr = ^DLLList;
  351.   DLLList = Record
  352.     DLLWrk: Array[0..3] of Byte;    { Work Area ? }
  353.     DLLMod: String[8];        { Module Name }
  354.   End;
  355.  
  356.   { One Entry in the Unit Code/Data Donor List }        {.CP07}
  357.  
  358.   UDonorPtr = ^UDonorRec;
  359.   UDonorRec = RECORD
  360.     UDExxx: Word;
  361.     UDEnam: String[8]    { Name of Donor Unit }
  362.   END;
  363.  
  364.   { One Entry in the Source File List }                {.CP11}
  365.  
  366.   SrcFilePtr = ^SrcFileRec;
  367.   SrcFileRec = RECORD
  368.     SrcFlag: Byte;        { 4=.PAS, 3=.INC, 5=.OBJ, 6=.RES    }
  369.     SrcPad:  Word;        { no apparent use - always zero ?   }
  370.     SrcTime: Word;        { File Time Stamp if SrcFlag=3 or 4 }
  371.     SrcDate: Word;        { File Date Stamp if SrcFlag=3 or 4 }
  372.     SrcName: SrcNam;    { Varying length FileName.Extn      }
  373.                 { (includes full path if TPWindows  }
  374.   END;
  375.  
  376.   { One Entry in the Trace Table }                {.CP12}
  377.  
  378.   TraceRecPtr = ^TraceRec;
  379.   TraceRec    = RECORD
  380.     TrName: LL;        { to Directory Entry of Proc/Method  }
  381.     TrFill: Word;        { to proc source file                }
  382.     TrPfx:  Word;        { bytes of data in front of code     }
  383.     TrBeg:  Word;        { Line Number of BEGIN Stmt          }
  384.     TrLNos: Word;        { Lines of Code to Execute in TRACE  }
  385.     TrExec: ARRAY[1..2]    { Model Array of bytes that map each }
  386.         OF Byte;    { line of code to be traced by DEBUG }
  387.   END;
  388.  
  389. FUNCTION  AddrCMapTab(U: UnitPtr): CMapTabPtr;            {.CP26}
  390. Function  AddrCodeArea(U: UnitPtr): Pointer;
  391. FUNCTION  AddrCodeFixUps(U: UnitPtr): FixUpPtr;
  392. Function  AddrDataArea(U: UnitPtr): Pointer;
  393. FUNCTION  AddrDataFixUps(U: UnitPtr): FixUpPtr;
  394. FUNCTION  AddrDict(U: UnitPtr; Hash: LL): DNamePtr;
  395. FUNCTION  AddrDLLTabOff(U: UnitPtr; Offset: Word): DLLPtr;
  396. FUNCTION  AddrDMapTab(U: UnitPtr): DMapTabPtr;
  397. FUNCTION  AddrHash(U: UnitPtr; Hash: LL): HashPtr;
  398. FUNCTION  AddrLGUnit(U: UnitPtr; TypeLG: LG): DNamePtr;
  399. FUNCTION  AddrNxtDLL(U: UnitPtr; Arg: DLLPtr): DLLPtr;
  400. FUNCTION  AddrNxtTrace(U: UnitPtr; T: TraceRecPtr): TraceRecPtr;
  401. FUNCTION  AddrPMapTab(U: UnitPtr): PMapPtr;
  402. FUNCTION  AddrProcType(S: DStubPtr): TypePtr;
  403. FUNCTION  AddrNxtSrc(U: UnitPtr; Arg: SrcFilePtr): SrcFilePtr;
  404. FUNCTION  AddrSrcTabOff(U: UnitPtr; Offset: Word): SrcFilePtr;
  405. FUNCTION  AddrStub(arg: DNamePtr): DStubPtr;
  406. FUNCTION  AddrTraceTab(U: UnitPtr): TraceRecPtr;
  407. FUNCTION  AddrType(U: UnitPtr; TypeLG: LG): TypePtr;
  408. FUNCTION  CountCMapSlots(U: UnitPtr): Integer;
  409. FUNCTION  CountDMapSlots(U: UnitPtr): Integer;
  410. FUNCTION  CountPMapSlots(U: UnitPtr): Integer;
  411. FUNCTION  FormLL(Base,Ceil: Pointer): LL;
  412. FUNCTION  GetTrExecSize(T: TraceRecPtr): Integer;
  413. FUNCTION  IsSystemUnit(U: UnitPtr): Boolean;
  414.  
  415.   { Function Below Removes PRIVATE Bit from Name Class }    {.CP06}
  416.  
  417. FUNCTION Public(Arg: Char): Char;
  418.             { BEGIN Public := Chr(Ord(Arg) AND $7F) END; }
  419. INLINE(    $58/        { POP    AX     }
  420.         $24/$7F);    { AND    AL,$7F    }
  421.  
  422. { -------------------------------------------------------- }    {.CP04}
  423. { PurgeAllUnits    - Removes all Units and Analyses from Heap }
  424.  
  425.   Procedure PurgeAllUnits;
  426.  
  427. { --------------------------------------------------------------- }{.CP05}
  428. { AnalyzeUnit    - Loads and analyzes a Unit; references to Units  }
  429. {          it USES are resolved to clarify LG references   }
  430.  
  431.   Function  AnalyzeUnit(Name: _UnitName; Path: String): UnitPtr;
  432.  
  433. { --------------------------------------------------------------- }{.CP13}
  434. { ResolveLG    - Checks all Directly referenced Units to locate  }
  435. {          the Unit and the Dictionary Entry for the owner }
  436. {          of the Descriptor referenced by an LG provided  }
  437. {          AnalyzeUnit has been called before-hand      }
  438.  
  439. Type
  440.   RespLG = Record        { Returned by ResolveLG    }
  441.     UPtr: UnitPtr;        { Pointer to Named Unit    }
  442.     Ownr: LL;        { LL to Owner of LG'd Item }
  443.   End;
  444.  
  445.   Procedure ResolveLG(N: _UnitName; L : LG; VAR R: RespLG);
  446.  
  447. { ---------------------------------------------------------- }    {.CP23}
  448. { FetchSurveyRec  - is called to fetch the next SurveyRec    }
  449. {            to support formatted Dictionary printing }
  450. {            of the primary Unit                 }
  451.  
  452. Type CoverId = (cvName,        { Dictionary Entry Headers }
  453.         cvHash,        { Hash Tables              }
  454.         cvType,        { Type Descriptors         }
  455.         cvINLN,        { INLINE Code Bytes        }
  456.         cvNULL);    { terminating status       }
  457.  
  458.   SurveyRecPtr = ^ SurveyRec;    { Output of Survey }
  459.  
  460.   SurveyRec = RECORD
  461.     LocLL  : LL;        { LL to location of data structure      }
  462.     LocOwn : LL;        { LL to Dictionary Header of Owner or 0 }
  463.     LocTyp : CoverId;    { Class of Structure (see above)        }
  464.     LocNxt : LL;        { LL to location of following structure }
  465.     LocLvl : Word;        { Nesting Level of entry                }
  466.   End;
  467.  
  468.   Procedure FetchSurveyRec (VAR S : SurveyRec);    { Gets Dictionary Survey }
  469.                                       { Results Sequentially   }
  470.  
  471. { ---------------------------------------------------------------- } {.CP53}
  472. { SortProcRefs    - is called to sort the reference information for  }
  473. {          PROC Maps into either CSEG or PROC map order to  }
  474. {          print.  BOTH sequences are used by TPU6.  Only a }
  475. {          Primary Unit gets these references built for it. }
  476. {                                   }
  477. { FetchMapRef    - is called to fetch a MapRefRec (see below) using }
  478. {          the map offset.  Only the primary Unit has such  }
  479. {          references constructed for it.           }
  480.  
  481. Type
  482.      MapFlags = (mfNULL,    { Undefined / Unused Entry       }
  483.          mfINTF,    { INTERFACE CONST/VAR Map Entry  }
  484.          mfIMPL,    { IMPLEMENTATION CONST/VAR Map   }
  485.          mfNEST,    { NESTED Scope Typed CONST DSeg  }
  486.          mfXTRN,    { EXTERNAL CONST/VAR DSeg        }
  487.          mfTVMT,    { VMT Template in CONST Map      }
  488.          mfTDMT,    { DMT Template in CONST Map     }
  489.          mfPROC,    { PROC Map Entry                 }
  490.          mfPRUI,        { PROC Map Entry - Unit Init     }
  491.          mfPDLL,    { PROC Map Entry - DLL Proc     }
  492.          mfCSEG);    { CSEG Map Entry                 }
  493.  
  494.      MapClass = (rPROC,        { PROC Map              }
  495.          rCSEG,        { CSeg Map              }
  496.          rVARS,        { VARS Map - Global VAR DSeg Map }
  497.          rCONS);    { CONS Map - Typed Constants Map }
  498.  
  499.   MapRefRecPtr = ^ MapRefRec;    { Output of VAR/CONST Map Survey }
  500.   MapRefRec = RECORD
  501.     MapTyp: MapFlags;    { Defining Scope Category (see above)   }
  502.     MapOfs: Word;        { Offset within Map Table               }
  503.     MapOwn: LL;        { DNAME of Parent Scope / PROC          }
  504.     MapSrc: Word;        { Offset in Source File / DLL List      }
  505.     MapLod: Word;        { Load Point Segment Offset-CODE/CONST  }
  506.     MapSiz: Word;        { Size of Segment / PROC (Bytes)        }
  507.  
  508.      CASE MapFlags OF
  509.     mfCSEG: (        {--CSEG/CONST Map Table Only--}
  510.          MapFxI: Word;    { Offset to Initial Fix-Up    }
  511.          MapFxJ: Word;    { Segment Fix-Up Byte Count   }
  512.         );
  513.     mfPROC: (        {-----PROC Map Table Only-----}
  514.          MapEPT: Word;    { Entry Point Offset for PROC }
  515.          MapCSM: Word;    { Offset in CSEG Map for PROC }
  516.         );
  517.     mfPDLL: (        {-----PROC DLL Entry Only-----}
  518.          MapNdx: Word;    { Index to DLL Entry Point    }
  519.          MapDLL: Word;    { Not Used at this time       }
  520.         );
  521.   END;
  522.  
  523.   SortMode =    (CSegOrder,    { Sort Proc Map into CSeg Order }
  524.          PMapOrder);    { Sort Proc Map into Proc Order }
  525.  
  526.   Procedure SortProcRefs (Mode: SortMode);  { PROC Map Ref Sorts   }
  527.  
  528.   Procedure FetchMapRef  (VAR S : MapRefRec;  { Gets map references  }
  529.                 C   : MapClass;   { for the primary unit }
  530.               Offset: Word);
  531.  
  532.  
  533. (**********************)                    {.CP03}
  534. (**) IMPLEMENTATION (**)
  535. (**********************)
  536. {$IFDEF TESTDBG}
  537. Uses    Crt;            { Used Only For Debugging }
  538. {$ENDIF}
  539.  
  540. Type
  541.         UnitMode  = (Entire,Partial);
  542.     TUnitPtr  = ^ TUnit;
  543.     RMapPtr   = ^ RMap;
  544.     MapTabPtr = ^ MapTab;
  545.     CvrPtr    = ^ CvrTab;
  546.     CvrRecPtr = ^ CvrRec;
  547.  
  548.      CvrRec = RECORD
  549.         LocLL  : LL;       { LL to location of data structure      }
  550.     LocOwn : LL;       { LL to Dictionary Header of Owner or 0 }
  551.     LocTyp : CoverId;  { Type of Structure                     }
  552.         LocLvl : Word;     { Entry Nesting Level in Dictionary     }
  553.      END;
  554.  
  555.      CvrTab = ARRAY[1..2]  OF CvrRec;       { Model of Queue     }
  556.      MapTab = ARRAY[0..99] OF MapRefRec; { Model of Cross-Refs  }
  557.  
  558.      RMapVec   = Array[MapClass] of RMapPtr;
  559.  
  560.      LdrRec = Record
  561.         LdrSiz : Word;
  562.         LdrUpt : Pointer;
  563.      End;
  564.      LdrVec = Array[1..5] Of LdrRec;    { Used by Segmented Loader }
  565.  
  566. { ----------------------------------------------------- }    {.CP38}
  567. { The TUnit Object is used to organize all information  }
  568. { known about a Unit.  It functions as an index node to }
  569. { allow reasonably fast access to a Unit by either name }
  570. { or by address.  It provides links RMap objects which  }
  571. { anchor "map" analyses.  It contains the controls that }
  572. { manage the dictionary "cover" built for each Unit.    }
  573. { ----------------------------------------------------- }
  574.  
  575.      TUnit = Object
  576.        Link:        TUnitPtr;    { To Next TUnit in List    }
  577.        UImg:        UnitPtr;    { To Unit Image on Heap    }
  578.        UCod:       ^Byte;    { To UNIT CODE Segments    }
  579.        UDta:       ^Byte;    { To Unit CONS Segments }
  580.        UFXC:       FixUpRecPtr; { To Unit CODE Fix-Ups  }
  581.        UFXD:       FixUpRecPtr;    { To Unit DATA Fix-Ups  }
  582.        USiz:        Word;    { Allocated Image Size    }
  583.        UCSz,            { Allocated Code  Size  }
  584.        UDSz,            { Allocated Data  Size  }
  585.        UFCz,            { Allocated FXC   Size  }
  586.        UFDz:       Word;    { Allocated FXD   Size  }
  587.        Name:        _UnitName;    { Name for Fast Search    }
  588.        CvrRMaps:   RMapVec;    { To Map Analyses    }
  589.        CvrQue:     CvrPtr;    { To Completed Survey    }
  590.        CvrSize:    LongInt;    { Allocation Size Bytes }
  591.        CvrLimit,        { Queue Max Subscript   }
  592.        CvrQueTail,        { Cover Queue Tail    }
  593.        CvrQueHead,        { Cover Queue Head    }
  594.        CvrQueMax:  Word;    { Cover Queue Ceiling    }
  595.        Destructor  Done;
  596.        Constructor Init(Id: _UnitName; Vector: LdrVec);
  597.        Procedure   DisposeQueue;
  598.        Procedure   CalcCovers;
  599.        Procedure   IndexMaps;
  600.        FUNCTION    QueuePos(Locn: LL): Word;
  601.        PROCEDURE   EnQueue(Arg: CvrRec);
  602.        FUNCTION    Queued(Key: LL) : Boolean;
  603.      End;  { TUnit }
  604.  
  605. { ----------------------------------------------------- }    {.CP17}
  606. { The RMap Object is used to organize the information   }
  607. { pertaining to Unit Map references.  One such object   }
  608. { is spawned for each Map type (CSeg,PROC,DSeg,CONST)   }
  609. { and this object stores allocator information about    }
  610. { the vector in which the references are stored.        }
  611. { ----------------------------------------------------- }
  612.  
  613.    RMap = Object
  614.     RMapTabPtr: MapTabPtr;        { To Map References }
  615.     RMapTabSiz: Word;        { Reference Counter }
  616.     Destructor  Done;
  617.     Constructor Init(Width: Word);
  618.     Procedure   SortPmap(Mode: SortMode);
  619.     Procedure   FetchRef(VAR S: MapRefRec; Offset: Word);
  620.     Procedure   StoreRef(    S: MapRefRec; Offset: Word);
  621.    End;
  622.  
  623. Const RefLen = SizeOf(MapRefRec); MapLen = SizeOf(DMapRec);
  624.       LstRoot: TUnitPtr   = Nil;
  625.       NullMap: MapRefRec  = (MapTyp: mfNULL; MapOfs: 0;
  626.                  MapOwn: $FFFF;  MapSrc: 0;
  627.                  MapLod: 0;      MapSiz: 0;
  628.                  MapEPT: 0;      MapCSM: 0);
  629.  
  630. VAR   CvrWork : CvrRec;
  631.  
  632. {$IFDEF TESTDBG}
  633. VAR  ExitSave: Pointer; Audit: Text;
  634.  
  635.   Procedure MyExit; FAR;
  636.   Begin
  637.      ExitProc := ExitSave;
  638.      If TextRec(Audit).Mode <> fmClosed Then Close(Audit);
  639.   End;
  640.  
  641. {$ENDIF}
  642.  
  643.      {   Begin Methods for   R M a p   }            {.CP18}
  644.  
  645. Constructor RMap.Init(Width: Word);
  646. Var I: Word; S: MapRefRec;
  647. Begin
  648.     RMapTabPtr := Nil; RMapTabSiz := Width DIV SizeOf(DMapRec);
  649.     IF RMapTabSiz > 0 Then
  650.     Begin
  651.        GetMem(RMapTabPtr,RMapTabSiz * RefLen);
  652.        S := NullMap;
  653.        If RMapTabPtr = Nil Then RMapTabSiz := 0
  654.        Else
  655.               For I := 0 To RMapTabSiz-1 Do Begin
  656.                  RMapTabPtr^[i] := S;
  657.                  Inc(S.MapOfs,SizeOf(DMapRec));
  658.               End;
  659.         End;
  660. End;
  661.  
  662. Destructor RMap.Done;                        {.CP05}
  663. Begin
  664.     IF RMapTabSiz > 0 Then FreeMem(RMapTabPtr,RMapTabSiz * RefLen);
  665.     RMapTabPtr := Nil; RMapTabSiz := 0;
  666. End;
  667.  
  668.    Function CSegSort(Var pA, pB): Boolean; Far;
  669.    Var A : MapRefRec Absolute Pa; B : MapRefRec Absolute Pb;
  670.    Begin
  671.     CSegSort := False;
  672.     If (A.MapTyp <> mfPDLL) AND (B.MapTyp <> mfPDLL) Then
  673.     Begin
  674.        If A.MapCSM < B.MapCSM Then CSegSort := True
  675.        Else  If A.MapCSM = B.MapCSM
  676.          Then If A.MapEPT < B.MapEPT Then CSegSort := True
  677.     End
  678.     Else CSegSort := Ord(A.MapTyp) < Ord(B.MapTyp)
  679.    End; {CSegSort}
  680.  
  681.    Function PMapSort(Var pA, pB): Boolean; Far;
  682.    Var A : MapRefRec Absolute Pa; B : MapRefRec Absolute Pb;
  683.    Begin PMapSort := A.MapOfs < B.MapOfs End;
  684.  
  685. Procedure RMap.SortPmap(Mode: SortMode);            {.CP25}
  686. Var CompareProc: _Compare;
  687. Begin {SortPMap}                        {.CP49}
  688.    If (RMapTabSiz > 1) AND (RMapTabPtr <> Nil) Then
  689.    Begin
  690.         Case Mode Of
  691.              CSegOrder: CompareProc := CSegSort;
  692.              PMapOrder: CompareProc := PMapSort;
  693.         End; {Case}
  694.     QuickSort( RMapTabPtr,
  695.            RMapTabSiz,
  696.            SizeOf(MapRefRec),
  697.                    CompareProc);
  698.    End;
  699. End; {SortPMap}
  700.  
  701. Procedure RMap.FetchRef(VAR S : MapRefRec; Offset : Word);    {.CP10}
  702. Var I : Word;
  703. Begin
  704.     If (Offset MOD MapLen) = 0
  705.     Then I := Offset Div MapLen
  706.     Else I := RMapTabSiz;
  707.     If NOT (I < RMapTabSiz)
  708.     Then S := NullMap
  709.     Else S := RMapTabPtr^[I];
  710. End;
  711.  
  712. Procedure   RMap.StoreRef(S : MapRefRec; Offset : Word);    {.CP09}
  713. Var I : Word;
  714. Begin
  715.     If (Offset MOD MapLen) = 0
  716.     Then I := Offset Div MapLen
  717.     Else I := RMapTabSiz;
  718.     If (I < RMapTabSiz)
  719.     Then RMapTabPtr^[I] := S
  720. End;
  721.  
  722.      {   Begin  Methods For   T U n i t   }            {.CP18}
  723.  
  724. Constructor TUnit.Init( Id: _UnitName;  Vector: LdrVec);
  725. Begin
  726.    Link := Nil;        Name := Id;        CvrQue     := Nil;
  727.    CvrQueTail := 0;     CvrQueHead := 0;        CvrQueMax := 0;
  728.    CvrSize    := 0;     CvrLimit   := 0;    
  729.    CvrRMaps[rPROC] := Nil;    CvrRMaps[rCSEG] := Nil;
  730.    CvrRMaps[rVARS] := Nil;    CvrRMaps[rCONS] := Nil;
  731.    UImg := Vector[1].LdrUpt; USiz := Vector[1].LdrSiz;        
  732.    UCod := Vector[2].LdrUpt; UCSz := Vector[2].LdrSiz;
  733.    UDta    := Vector[3].LdrUpt; UDSz := Vector[3].LdrSiz;
  734.    UFxC := Vector[4].LdrUpt; UFCz := Vector[4].LdrSiz;
  735.    UFxD := Vector[5].LdrUpt; UFDz := Vector[5].LdrSiz;
  736. End;  {TUnit.Init}
  737.  
  738. Procedure TUnit.DisposeQueue;                    {.CP05}
  739. Begin
  740.    If CvrQue <> Nil Then FreeMem(CvrQue,CvrSize);
  741.    CvrQue := Nil; CvrSize := 0; CvrLimit := 0;
  742. End;
  743.  
  744. Destructor  TUnit.Done;                        {.CP09}
  745. Begin
  746.    DisposeQueue;
  747.    If CvrRMaps[rPROC] <> Nil Then CvrRMaps[rPROC]^.Done;
  748.    If CvrRMaps[rCSEG] <> Nil Then CvrRMaps[rCSEG]^.Done;
  749.    If CvrRMaps[rVARS] <> Nil Then CvrRMaps[rVARS]^.Done;
  750.    If CvrRMaps[rCONS] <> Nil Then CvrRMaps[rCONS]^.Done;
  751.    If UImg <> Nil Then FreeMem(UImg,USiz); UImg := Nil; USiz := 0;
  752.    If UCod <> Nil Then FreeMem(UCod,UCsz); UCod := Nil; UCsz := 0;
  753.    If UDta <> Nil Then FreeMem(UDta,UDsz); UDta := Nil; UDsz := 0;
  754.    If UFxC <> Nil Then FreeMem(UFxC,UFCz); UFxC := Nil; UFCz := 0;
  755.    If UFxD <> Nil Then FreeMem(UFxD,UFDz); UFxD := Nil; UFDz := 0;
  756.  
  757. End;
  758.  
  759. Function SearchCover(Key: LL; P: CvrPtr; Tail: Word): Word;    {.CP21}
  760. VAR Lo, Mid, Hi : Word;
  761. BEGIN
  762.    Lo := 1; Hi := Tail;
  763.    REPEAT
  764.       ASM
  765.         XOR BX,BX    { make a Zero        }
  766.                 MOV AX,Lo       { fetch Lo           }
  767.                 ADD AX,Hi       { Add Hi             }
  768.                 RCR BH,1        { save carry         }
  769.                 SHR AX,1        { divide sum by 2    }
  770.                 OR  AH,BH       { restore carry      }
  771.                 MOV Mid,AX      { save (Lo+Hi) DIV 2 }
  772.       End;
  773.       IF Key > P^[Mid].LocLL
  774.       THEN Lo := Mid + 1
  775.       ELSE Hi := Mid - 1
  776.    UNTIL (Key = P^[Mid].LocLL) OR (Lo > Hi);
  777.    IF Key > P^[Mid].LocLL THEN Inc(Mid);
  778.    SearchCover := Mid
  779. End; {SearchCover}
  780.  
  781. FUNCTION TUnit.QueuePos(Locn : LL):Word;            {.CP07}
  782. VAR Lo, Mid, Hi : Word;
  783. BEGIN
  784.    IF CvrQueTail < 1
  785.    THEN QueuePos := 1
  786.    ELSE QueuePos := SearchCover(Locn,CvrQue,CvrQueTail);
  787. END; {QueuePos}
  788.  
  789. Procedure RaiseCover(Dest: Pointer; BytCnt, Slice: Word );    {.CP15}
  790. ASSEMBLER;
  791. ASM            { ASM used for speed only - can be done with FOR Loop }
  792.     PUSH DS        { Save DS for Turbo }
  793.     LES  SI,Dest    { ES = Seg(Dest^), SI = Ofs(Dest^) }
  794.     MOV  CX,BytCnt    { CX = Byte Count to Shift }
  795.     DEC  SI        { SI = Ofs(Dest^) - 1 }
  796.     MOV  DI,Slice    { DI = SizeOf(CvrRec) }
  797.     ADD  DI,SI    { DI = Ofs(Dest^) + SizeOf(CvrRec) - 1 }
  798.     MOV  AX,ES      { AX = Seg(Dest^) }
  799.     MOV  DS,AX      { DS = Seg(Dest^) }
  800.     STD        { Set Direction Right-To-Left }
  801.     REPNZ MOVSB    { Raise the queue }
  802.     POP  DS        { Restore DS for Turbo }
  803. End; {RaiseCover}
  804.  
  805. PROCEDURE TUnit.EnQueue(Arg : CvrRec);                {.CP31}
  806.  
  807. VAR Key : LL; Wide : LongInt; P, RP: ^CvrRec;
  808. BEGIN
  809. If CvrQue <> Nil Then
  810. If CvrQueTail < CvrLimit Then
  811. Begin
  812.    Key := QueuePos(Arg.LocLL);
  813.    RP := @CvrQue^[Key];                 { merely a speed-up }
  814.    IF Arg.LocLL < UImg^.UHPMT THEN
  815.    IF Key > CvrQueTail THEN
  816.    BEGIN
  817.       Inc(CvrQueTail);
  818.       CvrQue^[CvrQueTail] := Arg
  819.    END ELSE
  820.    IF Arg.LocLL <> RP^.LocLL THEN     { Raise higher entries to }
  821.    BEGIN                  { make room for insertion }
  822.       Inc(CvrQueTail);
  823.       P := @CvrQue^[CvrQueTail];    { merely a speed-up }
  824.       Wide := PtrDelta(P,RP);
  825.       RaiseCover(P,            { Destination }
  826.                Wide,            { Byte Count  }
  827.          SizeOf(CvrRec));    { Entry Width }
  828.       RP^ := Arg
  829.    END;
  830.    If RP^.LocLvl > Arg.LocLvl Then RP^.LocOwn := Arg.LocOwn Else
  831.    If RP^.LocLvl = Arg.LocLvl Then
  832.    If RP^.LocLL  > Arg.LocLL  Then RP^.LocOwn := Arg.LocOwn;
  833.    IF CvrQueTail > CvrQueMax THEN CvrQueMax := CvrQueTail;
  834. End;
  835. END; {EnQueue}
  836.  
  837. FUNCTION TUnit.Queued(Key : LL):Boolean;            {.CP12}
  838. VAR Loc : Word;
  839. BEGIN
  840.    Queued := False;
  841.    If CvrQue <> Nil Then
  842.    If CvrQueTail > 0   Then
  843.    Begin
  844.       Loc := QueuePos(Key);
  845.       IF Loc <= CvrQueTail
  846.       THEN Queued := Key = CvrQue^[Loc].LocLL
  847.    End;
  848. END; {Queued}
  849.  
  850. Procedure TUnit.CalcCovers;                    {.CP04}
  851. Const LvlLim = 256;
  852. Var Level: Word; QueLoad : Boolean; ECount: Longint;
  853.     USymbol: _LexName; A: CvrRec; LvlSav : Array[1..LvlLim] of LL;
  854.  
  855. {$IFDEF TESTDBG}                        {.CP19}
  856. Procedure CoverFault(Loc:LL);
  857. Begin
  858.       WriteLn;
  859.       WriteLn('Fault -- Unit: ',Name,', Loc: ',HexW(Loc));
  860.       WriteLn('Last Name: ',USymbol);
  861.       WriteLn('Level: ',Level,', ECount: ',ECount);
  862.       Loc := LL(ReadKey);
  863. End;
  864.  
  865. Procedure CoverAudit(A: String; B: Word);
  866. Begin
  867.     If NOT QueLoad Then
  868.     WriteLn(Audit,'Unit: ',name,', Loc: ',HexW(B),
  869.         ', Lvl: ',HexW(Level),', Entry: ',HexW(ECount),
  870.         ', Proc: ',A);
  871. End;
  872. {$ENDIF}
  873.    PROCEDURE CoverWrapUp;
  874.  
  875.       PROCEDURE CoverWrapPost(Loc,s:LL);                         {.CP10}
  876.       VAR J : LL;
  877.       BEGIN
  878.          j := QueuePos(s);
  879.          If CvrQue <> Nil Then
  880.      WITH CvrQue^[j] DO
  881.      IF LocLL = s THEN
  882.      IF (LocOwn > Loc) OR (LocOwn = 0)
  883.      THEN LocOwn := Loc;
  884.       END; {CoverWrapPost}
  885.  
  886.       PROCEDURE CoverWrapType(Loc: LL);                {.CP31}
  887.       VAR D : DNamePtr; S : DStubPtr; T : TypePtr; i,j,k : LL;
  888.          RP : VarStubPtr; DF : Char;
  889.       BEGIN
  890. {$IFDEF TESTDBG}
  891.         If (Loc < UImg^.UHIHT) OR (Loc > UImg^.UHPMT)
  892.         Then CoverFault(Loc);
  893. {$ENDIF}
  894.          D := AddrDict(UImg,Loc);        { Q entry  }
  895.      S := AddrStub(D);            { its stub }
  896.          RP := @S^.sRVF;
  897.      T := AddrType(UImg,S^.sQTD);
  898.      IF T <> Nil THEN            { TD in this unit }
  899.      BEGIN
  900.             DF := Public(D^.DForm);
  901.         CoverWrapPost(Loc,S^.sQTD.UntLL);
  902.         IF (T^.tpTC = 2) OR (T^.tpTC = 3) THEN
  903.         BEGIN
  904.            i := T^.RecdDict;
  905.            IF i <> Loc THEN
  906.            WHILE i <> 0 DO BEGIN
  907.               CoverWrapPost(Loc,i);
  908.           D := AddrDict(UImg,i);
  909.           S := AddrStub(D);
  910.           IF DF = 'R' THEN i := RP^.ROB ELSE
  911.           IF DF = 'S' THEN i := S^.sSHT
  912.           ELSE i := 0;
  913.            END  {While I}
  914.         END
  915.      END  {IF T <> Nil}
  916.       END;    {CoverWrapType}
  917.  
  918.    VAR i : Word;                        {.CP09}
  919.    BEGIN {CoverWrapUp}
  920.       If CvrQue <> Nil Then
  921.       For i := 1 TO CvrQueTail DO
  922.       WITH CvrQue^[i] DO
  923.       IF LocTyp = cvName THEN
  924.       IF Public(AddrDict(UImg,LocLL)^.DForm) = 'Q'
  925.       THEN CoverWrapType(LocLL)
  926.    END;    {CoverWrapUp}
  927.  
  928.    PROCEDURE CoverHash(Loc, Own: LL); FORWARD;            {.CP15}
  929.  
  930.    Procedure CoverInline(Loc,Own: LL);
  931.    Begin
  932. {$IFDEF TESTDBG}
  933.       CoverAudit('CoverInLine',Loc);
  934. {$ENDIF}
  935.       If NOT QueLoad
  936.       Then Inc(ECount) Else
  937.       Begin
  938.          A.LocLL   := Loc;    A.LocOwn := Own;
  939.          A.LocTyp  := cvINLN; A.LocLvl := Level;
  940.          Enqueue(A);
  941.       End;
  942.    End; {CoverInline}
  943.  
  944.    PROCEDURE CoverType(Loc, Own: LL);                {.CP23}
  945.    VAR T, TT : TypePtr;
  946.        Procedure CoverTypeTry(ALG: LG; Loc, Own: LL);
  947.         Begin
  948.            If AddrType(UImg,ALG) <> Nil THEN
  949.            IF ALG.UntLL <> Loc THEN
  950.            CoverType(ALG.UntLL,Own);
  951.         End;
  952.    BEGIN {CoverType}
  953. {$IFDEF TESTDBG}
  954.       If (Loc < UImg^.UHIHT) OR (Loc > UImg^.UHPMT)
  955.       Then CoverFault(Loc);
  956.       CoverAudit('CoverType',Loc);
  957. {$ENDIF}
  958.       If NOT QueLoad
  959.       Then Inc(ECount) Else
  960.       Begin
  961.          A.LocLL   := Loc;    A.LocOwn := Own;
  962.          A.LocTyp  := cvType; A.LocLvl := Level;
  963.          Enqueue(A);
  964.       End;
  965.       T := TypePtr(PtrAdjust(UImg,Loc));
  966.       IF T <> Nil THEN
  967.       WITH T^ DO                        {.CP36}
  968.       CASE tpTC OF
  969.          $01: BEGIN
  970.               CoverTypeTry(BaseType,Loc,Own);
  971.                  CoverTypeTry(BounDesc,Loc,Own);
  972.           END; {CASE $01}
  973.      $02: IF RecdHash <> 0 THEN CoverHash(RecdHash,Own);
  974.      $03: IF ObjtHash <> 0 THEN CoverHash(ObjtHash,ObjtName);
  975.      $04,
  976.          $05: CoverTypeTry(FileType,Loc,Own);
  977.      $06: CoverTypeTry(T^.PFRes,Loc,Own);
  978.      $07: CoverTypeTry(SetBase,Loc,Own);
  979.      $08: CoverTypeTry(PtrBase,Loc,Own);
  980.      $09: BEGIN
  981.               CoverTypeTry(StrBase,Loc,Own);
  982.                  CoverTypeTry(StrBound,Loc,Own);
  983.           END; {CASE $09}
  984.      $0C, $0D,
  985.      $0E: CoverTypeTry(Cmpat,Loc,Own);
  986.      $0F: IF AddrType(UImg,Cmpat) <> Nil THEN
  987.               IF Cmpat.UntLL <> Loc Then
  988.           Begin
  989.                    CoverType(Cmpat.UntLL,Own);
  990.          { now cover the SET descriptor that follows }
  991.          TT := TypePtr(PtrAdjust(@Cmpat,SizeOf(T^.Cmpat)));
  992.                  If FormLL(UImg,TT) <> Loc Then
  993.                If NOT QueLoad
  994.                Then Inc(ECount) Else
  995.                Begin
  996.                  A.LocLL   := Loc;    A.LocOwn := Own;
  997.                  A.LocTyp  := cvType; A.LocLvl := Level;
  998.                  Enqueue(A);
  999.                End;
  1000.           END; {CASE $0F}
  1001.       END;  {CASE tpTC}
  1002.    END;  {CoverType}
  1003.  
  1004.    PROCEDURE CoverName(Loc, Own: LL);                {.CP21}
  1005.    VAR C: Char; D: DNamePtr; S: DStubPtr;  T: TypePtr;
  1006.    BEGIN {CoverName}
  1007.       Repeat
  1008. {$IFDEF TESTDBG}
  1009.          If (Loc < UImg^.UHIHT) OR (Loc > UImg^.UHPMT)
  1010.      Then CoverFault(Loc);
  1011.          CoverAudit('CoverName',Loc);
  1012. {$ENDIF}
  1013.          D := AddrDict(UImg,Loc);
  1014.          USymbol := D^.DSymb;
  1015.          If NOT QueLoad
  1016.          Then Inc(ECount) Else
  1017.          Begin
  1018.             A.LocLL   := Loc;    A.LocOwn := Own;
  1019.             A.LocTyp  := cvName; A.LocLvl := Level;
  1020.             Enqueue(A);
  1021.          End;
  1022.          S := AddrStub(D);
  1023.          C := Public(D^.DForm);
  1024.          WITH S^ DO
  1025.          CASE C OF                        {.CP20}
  1026.          'P': IF AddrType(UImg,sPTD) <> Nil
  1027.                  THEN CoverType(sPTD.UntLL,0);
  1028.      'Q': IF AddrType(UImg,sQTD) <> Nil
  1029.                  THEN CoverType(sQTD.UntLL,Loc);
  1030.      'X': IF AddrType(UImg,sQTD) <> Nil
  1031.                  THEN CoverType(sQTD.UntLL,0);
  1032.      'R': IF AddrType(UImg,sRTD) <> Nil
  1033.                  THEN CoverType(sRTD.UntLL,0);
  1034.      'S': BEGIN
  1035.              IF sSHT <> 0 THEN CoverHash(sSHT,Loc);
  1036.          T := AddrProcType(S);
  1037.          CoverType(FormLL(T,UImg),Loc);
  1038.          IF (sSTp AND $02) <> 0 THEN
  1039.          CoverInLine(FormLL(UImg,@T^.PFPar[T^.PNPrm+1]),Loc);
  1040.           END; {CASE 'S'}
  1041.          END; {CASE C}
  1042.          Loc := D^.HLink;
  1043.       Until Loc = 0;
  1044.    END; {CoverName}
  1045.  
  1046.    PROCEDURE CoverHash(Loc, Own: LL);                {.CP31}
  1047.    VAR HLim, I : LL; H : HashPtr; Cycle: Boolean;
  1048.    BEGIN {CoverHash}
  1049.       Cycle := False; I := Level;
  1050.       While (I > 0) AND NOT Cycle DO Begin
  1051.          Cycle := LvlSav[I] = Loc;
  1052.          Dec(I);
  1053.       End;
  1054.       If Not Cycle Then
  1055.       Begin
  1056.           If NOT QueLoad
  1057.           Then Inc(ECount) Else
  1058.           Begin
  1059.            A.LocLL := Loc;      A.LocOwn := Own;
  1060.            A.LocTyp  := cvHash; A.LocLvl := Level;
  1061.            Enqueue(A);
  1062.           End;
  1063.         If Level < LvlLim Then Inc(Level);
  1064.         LvlSav[Level] := Loc;
  1065. {$IFDEF TESTDBG}
  1066.         If (Loc < UImg^.UHIHT) OR (Loc >= UImg^.UHPMT)
  1067.         Then CoverFault(Loc);
  1068.         CoverAudit('CoverHash',Loc);
  1069. {$ENDIF}
  1070.         H := AddrHash(UImg,Loc);
  1071.         HLim := (H^.Bas DIV SizeOf(LL));
  1072.         FOR I := 0 TO HLim DO
  1073.           IF H^.Slt[I] <> 0 THEN CoverName(H^.Slt[I],Own);
  1074.         Dec(Level);
  1075.       End;
  1076.    END; {CoverHash}
  1077.  
  1078. Begin {CalcCovers}                        {.CP32}
  1079. {$IFDEF TESTDBG}
  1080.    ReWrite(Audit);
  1081. {$ENDIF}
  1082.    Level := 0; ECount := 0; QueLoad := False;
  1083.    USymbol := '';
  1084.    If UImg <> Nil Then
  1085.    CoverHash(UImg^.UHDHT,0);               { Debug Rtn Hash Table  }
  1086.    DisposeQueue;
  1087.    If ECount > 0 Then
  1088.    Begin
  1089.       CvrLimit := ECount + 2;
  1090.       CvrSize  := CvrLimit * SizeOf(CvrRec);
  1091.       GetMem(CvrQue,CvrSize);
  1092.       If CvrQue <> Nil Then
  1093.       Begin
  1094.          QueLoad := True;
  1095.          A.LocLL  := UImg^.UHIHT;    A.LocOwn := 0;
  1096.          A.LocTyp := cvHash;         A.LocLvl := 0;
  1097.          Enqueue(A);
  1098.          CoverHash(UImg^.UHDHT,0);
  1099.          CoverWrapUp;
  1100.       End Else
  1101.       Begin
  1102.          CvrSize := 0;
  1103.          CvrLimit := 0;
  1104.       End;
  1105.    End;
  1106. {$IFDEF TESTDBG}
  1107.    Close(Audit);
  1108. {$ENDIF}
  1109. End;  {CalcCovers}
  1110.  
  1111.                                                                 {.PA} {
  1112.   The following method uses the output of method "CalcCovers" to browse the
  1113.   symbol dictionary and discover relations involving the CSeg Map, the PROC
  1114.   Map, the Global VAR DSeg Map and the Typed CONST DSeg Map.  The relations
  1115.   can involve Fix-Up data, the Trace Table, the Source File List, and the
  1116.   various code and data segments contained in the latter part of the unit
  1117.   file.  These relations are saved in the heap for later retrieval by the
  1118.   print routines.
  1119. }
  1120.  
  1121. Procedure TUnit.IndexMaps;                    {.CP02}
  1122. Var NObj: Word;
  1123.  
  1124.    { This Procedure computes the size of each }            {.CP39}
  1125.    { PROC and adds the result to the Xref map }
  1126.  
  1127.    Procedure SizeProcs;
  1128.    Var I, J, K : Word; Pc, Pp : MapTabPtr; Rp, Rc : RMapPtr;    
  1129.    Begin
  1130.       I := 0; K := 0;
  1131.       Rp := CvrRMaps[rPROC];        { Get RMap Proc Pointer }
  1132.       If Rp <> Nil Then
  1133.       Begin
  1134.          Pp := Rp^.RMapTabPtr;        { Get Proc Ref Pointer }
  1135.          J  := Rp^.RMapTabSiz;        { Get Slot Count       }
  1136.       End Else
  1137.       Begin Pp := Nil; J := 0 End;
  1138.       While (Pp^[K].MapTyp <> mfPDLL) AND (K < J) Do Inc(K);
  1139.       If K < J Then J := K;
  1140.       Rc := CvrRMaps[rCSEG];            { Get RMap Cod Pointer }
  1141.       If Rc <> Nil
  1142.       Then Pc := Rc^.RMapTabPtr            { Get CSeg Ref Pointer }
  1143.       Else Pc := Nil;
  1144.       If (J>0) AND (Pc <> Nil) Then
  1145.       While I < J-1 Do With Pp^[I] Do Begin
  1146.          If Pp^[I].MapCSM <> $FFFF Then
  1147.            If Pp^[I].MapCSM = Pp^[I+1].MapCSM
  1148.            Then Pp^[I].MapSiz := Pp^[I+1].MapEPT - Pp^[I].MapEPT
  1149.            Else Begin
  1150.              K := Pp^[I].MapCSM DIV SizeOf(CMapRec);
  1151.              Pp^[I].MapSiz := Pc^[K].MapLod + Pc^[K].MapSiz - Pp^[I].MapEPT;
  1152.            End;
  1153.          Inc(I);
  1154.       End;
  1155.       If (Pp <> Nil) AND (J>0) Then
  1156.       With Pp^[J-1] Do
  1157.       If MapCSM <> $FFFF Then
  1158.       Begin
  1159.          K := MapCSM DIV SizeOf(CMapRec);
  1160.          MapSiz := Pc^[K].MapLod + Pc^[K].MapSiz - MapEPT;
  1161.       End;
  1162.    End; {SizeProcs}
  1163.  
  1164.    { This Procedure Initializes the CSeg Xref Map }        {.CP26}
  1165.    { and sets CSeg Load Points and Fix-Up Offsets }
  1166.  
  1167.    Procedure PrimeCSegs;
  1168.    Var Cx, Cn, I, N : Word; D : DMapTabPtr; LBaseC, LBaseD, LBaseF: Word;
  1169.        C : CMapTabPtr; P : PMapPtr; Rmt, Rmv : MapTabPtr;
  1170.    Begin
  1171.       Rmt := CvrRMaps[rCSEG]^.RMapTabPtr;
  1172.       N   := CvrRMaps[rCSEG]^.RMapTabSiz;
  1173.       Cn  := CountCMapSlots(UImg);
  1174.       C   := AddrCMapTab(UImg);
  1175.       LBaseC := 0; LBaseD := 0; LBaseF := 0;
  1176.  
  1177.       If (C <> Nil) AND (Cn > 0) Then
  1178.       For Cx := 0 To Cn-1 Do    { First, we add Info from CSeg  }
  1179.       With C^[Cx], Rmt^[Cx] Do  { Map to our CSeg MapRefTab and }
  1180.       Begin                     { Calc Fix-Up Offsets           }
  1181.          MapTyp := mfCSEG;
  1182.          MapSrc := 0;
  1183.          MapLod := LBaseC;    { Save Offset to Load Point    }
  1184.          MapSiz := CSegCnt;    { Save Segment Byte Count    }
  1185.          MapFxI := LBaseF;    { Save Offset to Fix-Ups    }
  1186.          MapFxJ := CSegRel;    { Save Fix-Ups Byte Count    }
  1187.          Inc(LBaseC,CSegCnt);
  1188.          Inc(LBaseF,CSegRel);
  1189.       End;
  1190.  
  1191.       { Similarly for Typed Constant Data Segments }        {.CP52}
  1192.  
  1193.       Rmv := CvrRMaps[rCONS]^.RMapTabPtr;
  1194.       N   := CvrRMaps[rCONS]^.RMapTabSiz;
  1195.       D   := AddrDMapTab(UImg);
  1196.  
  1197.       LBaseF := 0;
  1198.       If D <> Nil Then
  1199.       For Cx := 0 To N-1 Do     { First, we add Info from DSeg  }
  1200.       With D^[Cx], Rmv^[Cx] Do  { Map to our DSeg MapRefTab and }
  1201.       Begin                     { Calc Fix-Up Offsets           }
  1202.          MapSrc := 0;
  1203.          MapSiz := DSegCnt;
  1204.          MapLod := LBaseD;
  1205.          MapFxI := LBaseF;
  1206.          MapFxJ := DSegRel;
  1207.          Inc(LBaseD,DSegCnt);
  1208.          Inc(LBaseF,DSegRel);
  1209.          If DSegOwn <> 0 Then
  1210.          Begin MapOwn := DSegOwn; MapTyp := mfTVMT End;
  1211.       End;
  1212.  
  1213.       { Now, we do a similar job for the PROC Map }
  1214.  
  1215.       Rmv := CvrRMaps[rPROC]^.RMapTabPtr;
  1216.       N   := CvrRMaps[rPROC]^.RMapTabSiz;
  1217.       P   := AddrPMapTab(UImg);
  1218.  
  1219.       If P <> Nil Then
  1220.       For Cx := 0 To N-1 Do
  1221.       With P^[Cx], Rmv^[Cx] Do
  1222.       Begin
  1223.          MapCSM := CSegOfs;
  1224.          MapEPT := CSegJmp;
  1225.          MapSrc := 0;
  1226.          If Odd(ProcWd2 SHR 2) Then    { We Have a DLL Entry }
  1227.          Begin
  1228.         MapTyp := mfPDLL;
  1229.             MapNdx := CSegJmp;
  1230.             MapSrc := CSegOfs;
  1231.             MapDLL := ProcWd2;
  1232.          End Else
  1233.          If MapCSM <> $FFFF Then
  1234.          Begin
  1235.             MapTyp := mfPROC;
  1236.             I := MapCSM DIV SizeOf(CMapRec);
  1237.             MapEPT := MapEPT + Rmt^[I].MapLod;  { Relocate Entry Point }
  1238.          End;
  1239.          If Cx = 0 Then MapTyp := mfPRUI; { flag unit init code }
  1240.       End;
  1241.  
  1242.    End; { PrimeCSegs }
  1243.  
  1244.    { This Proc updates the CSeg Xref Table with data from the }    {.CP58}
  1245.    { Trace and PROC Tables that allow us to determine which   }
  1246.    { source file furnished the CSeg for the map entry.        }
  1247.  
  1248.    Procedure FinalCSegs;
  1249.    Var Nc, I, Np, Sf, Sn: Word;
  1250.        Ps, Ph: SrcFilePtr; Pt: TraceRecPtr; PRc, PRp: MapTabPtr;
  1251.    Begin
  1252.       Ps := AddrSrcTabOff(UImg,0); Ph := Ps;    { Source File List }
  1253.       Sf := 0; Sn := 0;              { Total Src, non-Obj Files }
  1254.       While Ps <> Nil Do Begin
  1255.          Inc(Sf);                               { Inc Total Source Files }
  1256.          If Ps^.SrcFlag <> $05 Then Inc(Sn);    { Inc Non-Obj File Count }
  1257.          Ps := AddrNxtSrc(UImg,Ps);             { point to next src ntry }
  1258.       End;
  1259.       NObj := Sf - Sn; { Total *.OBJ Files }      Ps := Ph; { Restore Ps }
  1260.  
  1261.       If (NObj > 0) AND (CvrRMaps[rCSEG] <> Nil) Then { have *.OBJ's in lst }
  1262.       Begin
  1263.          PRc:= CvrRMaps[rCSEG]^.RMapTabPtr;
  1264.          Nc := CvrRMaps[rCSEG]^.RMapTabSiz;
  1265.          For I := 1 to Sn Do Ps := AddrNxtSrc(UImg,Ps);
  1266.          For I := (Nc-NObj) To Nc-1 Do
  1267.          With PRc^[I] Do Begin
  1268.             MapSrc := FormLL(Ph,Ps);
  1269.             Ps := AddrNxtSrc(UImg,Ps);
  1270.          End;           { *.OBJ Handler }
  1271.  
  1272.       { If Pascal Include Files are present, Only the Trace Table Knows }
  1273.       { and this is noted only if these files contain PROCs.  This can  }
  1274.       { be used to get the source file (actual) in these cases.  Scan   }
  1275.       { the trace table and compare its PROC pointer with PROC Name LL  }
  1276.       { in our PROC Ref table.  If match, then trace entry has source   }
  1277.       { info that applies to this proc (which is part of some CSeg) and }
  1278.       { the PROC Ref entry has the CSeg Map Offset which we use to make }
  1279.       { the linkage to our CSeg Ref table to save source file offset.   }
  1280.  
  1281.          Pt := AddrTraceTab(UImg);
  1282.          If CvrRMaps[rPROC] <> Nil Then If Nc > 0 Then
  1283.          Begin
  1284.             PRp := CvrRMaps[rPROC]^.RMapTabPtr;
  1285.             Np  := CvrRMaps[rPROC]^.RMapTabSiz;
  1286.             While Pt <> Nil Do With Pt^ Do Begin      {For ALL Trace Entries}
  1287.                I := 0;
  1288.                While I < Np Do With PRp^[I] Do Begin  {For ALL PROC Entries }
  1289.                   If MapTyp <> mfPDLL Then
  1290.                   If MapOwn = Trname Then             {Proc has Trace Entry }
  1291.                   Begin
  1292.                      PRc^[MapCSM DIV SizeOf(CMapRec)].MapSrc := Trfill;
  1293.                      I := Np;   {quit loop and try next trace entry}
  1294.                   End;
  1295.                   Inc(I);
  1296.                End;
  1297.                Pt := AddrNxtTrace(UImg,Pt);
  1298.             End;
  1299.          End;
  1300.       End;
  1301.    End;  {FinalCSegs}
  1302.  
  1303.    { This Procedure updates the CONST Xref Table with data from   }{.CP54}
  1304.    { various sources to get offsets to Fix-Up data and to try to  }
  1305.    { locate the file in the Source File List that contributed     }
  1306.    { this entry.  Any entry NOT defined in the Pascal Source will }
  1307.    { have mfNULL as its MapTyp.  We will change such entries to   }
  1308.    { mfXTRN and try to decide who spawned them.  This problem is  }
  1309.    { strictly undecidable.  We can guess that a Fix-Up in some    }
  1310.    { CSeg that references our entry is from the *.OBJ spawned the }
  1311.    { block, but that is the closest we can get to the truth.      }
  1312.  
  1313.    Procedure FinalCONST;
  1314.    Var I, N : Word; HaveXtrn : Boolean; Rmt : MapTabPtr;
  1315.        LBaseD, LBaseF: Word; Pt : TypePtr;
  1316.    Begin
  1317.       If CvrRMaps[rCONS] <> Nil Then
  1318.       Begin
  1319.          Rmt := CvrRMaps[rCONS]^.RMapTabPtr;
  1320.            N   := CvrRMaps[rCONS]^.RMapTabSiz;
  1321.            HaveXtrn := False;
  1322.          LBaseD := 0; LBaseF := 0;
  1323.  
  1324.            If (N > 0) AND (Rmt <> Nil) Then
  1325.            Begin
  1326.             For I := 0 To N-1 Do With Rmt^[I] Do
  1327.             Case MapTyp of
  1328.  
  1329.            mfNULL:
  1330.                        If NObj > 0 Then
  1331.                        Begin
  1332.                          MapTyp := mfXTRN;
  1333.                          HaveXtrn := True;
  1334.                        End;
  1335.  
  1336.                mfTVMT:
  1337.                        Begin
  1338.                            Pt := TypePtr(PtrAdjust(UImg,MapOwn));
  1339.                            If Pt <> Nil Then
  1340.                            If Pt^.ObjtDMTp = MapOfs
  1341.                            Then MapTyp := mfTDMT;
  1342.                     End;
  1343.             End; {Case}         { Fix-Up Offsets are now set }
  1344.             { Source File problem deferred until later }
  1345.            End;
  1346.       End;
  1347.  
  1348.       If CvrRMaps[rVARS] <> Nil Then
  1349.       Begin
  1350.           Rmt := CvrRMaps[rVARS]^.RMapTabPtr;  { Classify VARS Too }
  1351.           N   := CvrRMaps[rVARS]^.RMapTabSiz;
  1352.           If (N > 0) AND (Rmt <> Nil) AND (NObj > 0)
  1353.     Then For I := 0 To N-1 Do With Rmt^[I] Do
  1354.              If MapTyp = mfNULL Then MapTyp := mfXTRN
  1355.       End;
  1356.    End;  {FinalCONST}
  1357.  
  1358. Var I, J, DHT, IHT : Word; C : Char;                {.CP29}
  1359.     Pn : DNamePtr; Ps : DStubPtr; Pv : VarStubPtr; Pm: RMapPtr;
  1360.     Pp : PMapRecPtr; Tc, Tv, Td : DMapRecPtr; V : CvrRec; Q, Qc : MapRefRec;
  1361.                      Ndx : MapClass; SystemUnit, InINTF : Boolean;
  1362. Begin {IndexMaps}
  1363.  
  1364.    For Ndx := rPROC To rCONS Do
  1365.        If CvrRMaps[Ndx] <> Nil Then CvrRMaps[Ndx]^.Done;
  1366.  
  1367.    CvrRMaps[rCONS] := New(RMapPtr,Init(UImg^.UHDMT-UImg^.UHTMT));
  1368.    CvrRMaps[rVARS] := New(RMapPtr,Init(UImg^.UHDLL-UImg^.UHDMT));
  1369.    CvrRMaps[rPROC] := New(RMapPtr,Init(UImg^.UHCMT-UImg^.UHPMT));
  1370.    CvrRMaps[rCSEG] := New(RMapPtr,Init(UImg^.UHTMT-UImg^.UHCMT));
  1371.  
  1372.    DHT        :=  UImg^.UHDHT; IHT := UImg^.UHIHT;
  1373.    SystemUnit :=  IsSystemUnit(UImg);
  1374.  
  1375.  (*  If CvrRMaps[rCSEG]^.RMapTabSiz > 0 { Initialize CSeg Map Refs }
  1376.    Then *) PrimeCSegs;
  1377.  
  1378.    For I := 1 To CvrQueTail Do Begin    { Get CONST/VAR Mapping }
  1379.       V := CvrQue^[I];
  1380.       If V.LocTyp = cvName Then
  1381.       Begin
  1382.          Tc := Ptr(Seg(UImg^),Ofs(UImg^)+UImg^.UHTMT); { CONS Map }
  1383.          Tv := Ptr(Seg(UImg^),Ofs(UImg^)+UImg^.UHDMT); { DSeg Map }
  1384.          Pn := Ptr(Seg(UImg^),Ofs(UImg^)+V.LocLL);
  1385.          Ps := AddrStub(Pn);  C := Public(Pn^.DForm);
  1386.  
  1387.          If C = 'R' Then    { a data instance of some kind }    {.CP37}
  1388.          Begin
  1389.             If Ps^.sRAM < $02 Then { a global variable or typed const }
  1390.             Begin
  1391.                Pv := @Ps^.sRVF;
  1392.                J := Pv^.TOB;
  1393.                InINTF := (IHT = DHT) OR SystemUnit OR (DHT > V.LocLL);
  1394.  
  1395.                If Ps^.sRAM = $00 Then
  1396.                Begin                { it's a Global Variable }
  1397.                   Pm := CvrRMaps[rVARS];
  1398.                   Pm^.FetchRef(Q,Pv^.TOB);
  1399.                   Td := Ptr(Seg(Tv^),Ofs(Tv^)+J);
  1400.                   Q.MapSiz := Td^.DSegCnt;
  1401.                   If InINTF Then Q.MapTyp := mfINTF
  1402.                             Else Q.MapTyp := mfIMPL;
  1403.                   Pm^.StoreRef(Q,Pv^.TOB);
  1404.                End Else
  1405.                Begin                { it's a Typed Constant  }
  1406.                   Pm := CvrRMaps[rCONS];
  1407.                   Pm^.FetchRef(Q,Pv^.TOB);
  1408.                   Td := Ptr(Seg(Tc^),Ofs(Tc^)+J);
  1409.                   If Td^.DSegOwn <> 0 Then Begin
  1410.                      Q.MapTyp := mfTVMT;
  1411.                      Q.MapOwn := Td^.DSegOwn;   { Owner is OBJECT Name  }
  1412.                   End Else
  1413.                   If V.LocLvl = 1
  1414.           Then If InINTF Then Q.MapTyp := mfINTF
  1415.                    Else Q.MapTyp := mfIMPL
  1416.                   Else Begin
  1417.                      Q.MapTyp := mfNEST;
  1418.                      Q.MapOwn := V.LocOwn;      { Owner is PROC scope   }
  1419.                   End;
  1420.                   Pm^.StoreRef(Q,Pv^.TOB);
  1421.                End;   { Typed Constant    }
  1422.             End;      { Variable/Constant }
  1423.          End          { Type 'R' Stub     }
  1424.  
  1425.          Else                             { Check for PROC Map } {.CP20}
  1426.          If C = 'S' Then                  { It's a PROC ...... }
  1427.          If (Ps^.sSTP AND $02) = 0 Then   { ... AND NOT INLINE }
  1428.          Begin
  1429.             Pm := CvrRMaps[rPROC];        { Get Method Pointer }
  1430.             Pm^.FetchRef(Q,Ps^.sSPM);
  1431.             Q.MapOwn := V.LocLL;         { Get PROC Name Offset }
  1432.             Pm^.StoreRef(Q,Ps^.sSPM);
  1433.          End;  { Type 'S' Stub }
  1434.       End;     { DName Entry   }
  1435.    End;        { FOR           }
  1436.  
  1437.    If CvrRMaps[rCSEG]^.RMapTabSiz > 0 Then FinalCSegs; { Finish CSeg Refs }
  1438.  
  1439.    CvrRMaps[rPROC]^.SortPMap(CSegOrder);      { Sort PROCS in Load Order }
  1440.    SizeProcs;                      { Get Proc Size(Bytes)  }
  1441.    CvrRMaps[rPROC]^.SortPMap(PMapOrder);      { Sort PROCS in PMap Order }
  1442.    If CvrRMaps[rCONS] <> Nil Then FinalCONST;    { Finish CONST Refs }
  1443.  
  1444. End; {IndexMaps}
  1445.  
  1446.       (*   E N D    M E T H O D S   *)
  1447.  
  1448. Function FindCover(U : UnitPtr) : TUnitPtr;            {.CP11}
  1449. Var S : TUnitPtr;
  1450. Begin
  1451.    FindCover := Nil; S := LstRoot;
  1452.    While S <> Nil Do
  1453.      If S^.UImg <> U Then S := S^.Link Else
  1454.      Begin
  1455.         FindCover := S;
  1456.         S := Nil
  1457.      End;
  1458. End; {FindCover}
  1459.  
  1460.   { Procedure Below Traps Pointer Violations }            {.CP07}
  1461.  
  1462. PROCEDURE CheckPtrs(U, V: Pointer);
  1463. BEGIN
  1464.     IF (U = Nil) OR (V = Nil) OR (Seg(U^) <> Seg(V^))
  1465.     THEN RunError(215);
  1466. END; {CheckPtrs}
  1467.  
  1468.   { Function Below Computes an LL from two Pointers }        {.CP09}
  1469.  
  1470. FUNCTION  FormLL(Base, Ceil: Pointer): LL;
  1471. BEGIN
  1472.     CheckPtrs(Base,Ceil);
  1473.     IF Ofs(Base^) > Ofs(Ceil^)
  1474.         THEN FormLL := LL(Ofs(Base^)-Ofs(Ceil^))
  1475.         ELSE FormLL := LL(Ofs(Ceil^)-Ofs(Base^));
  1476. END;
  1477.  
  1478.   { Function Below Checks to See if Unit Name is "SYSTEM" }    {.CP06}
  1479.  
  1480. FUNCTION  IsSystemUnit(U: UnitPtr): Boolean;
  1481. BEGIN
  1482.    IsSystemUnit := DNamePtr(Ptr(Seg(U^),Ofs(U^)+U^.UHUDH))^.DSymb = 'SYSTEM'
  1483. END;
  1484.  
  1485.   { Function Finds The Stub Belonging to a Dictionary Header }    {.CP08}
  1486.  
  1487. FUNCTION  AddrStub(Arg: DNamePtr): DStubPtr;
  1488. CONST PrefixSize = SizeOf(LL)+SizeOf(Char) + 1;
  1489. BEGIN
  1490.   If Arg = Nil Then AddrStub := Nil Else
  1491.   AddrStub := PtrAdjust(Arg,PrefixSize + Ord(Arg^.DSymb[0]))
  1492. END;
  1493.  
  1494.   { Function Below Gets Pointer to Hash Table }                  {.CP07}
  1495.  
  1496. FUNCTION  AddrHash(U: UnitPtr; Hash: LL): HashPtr;
  1497. BEGIN
  1498.    If U = Nil Then AddrHash := Nil Else
  1499.    AddrHash := HashPtr(PtrAdjust(U,Hash))
  1500. END;
  1501.  
  1502.   { Function Below Gets Pointer to Dictionary Entry using LL }   {.CP04}
  1503.  
  1504. FUNCTION  AddrDict(U: UnitPtr; Hash: LL): DNamePtr;
  1505. BEGIN
  1506.    If U = Nil Then AddrDict := Nil Else
  1507.    AddrDict := DNamePtr(PtrAdjust(U,Hash))
  1508. END;
  1509.  
  1510.   { Function Below Gets Pointer to Type Descriptor if Local to Unit } {.CP15}
  1511.  
  1512. FUNCTION  AddrType(U: UnitPtr; TypeLG: LG): TypePtr;
  1513. VAR D:DNamePtr; S: DStubPtr; R: LL;
  1514. BEGIN
  1515.    AddrType := Nil;
  1516.    If U <> Nil Then
  1517.    Begin
  1518.     D := AddrDict(U,U^.UHUDH);      {point to our unit DE}
  1519.     S := AddrStub(D);               {point to its stub   }
  1520.     R := FormLL(U,S);               {get offset to stub  }
  1521.     IF R = TypeLG.UntId             {if offset matches   }
  1522.     THEN AddrType := TypePtr(PtrAdjust(U,TypeLG.UntLL));
  1523.    End;
  1524. END;
  1525.  
  1526. { Function Below Gets Pointer to Unit Descriptor for Type via LG } {.CP21}
  1527.  
  1528. FUNCTION  AddrLGUnit(U: UnitPtr; TypeLG: LG): DNamePtr;
  1529. VAR D: DNamePtr; S: DStubPtr; R: LL;
  1530. BEGIN
  1531.     D := AddrDict(U,U^.UHUDH);      {point to our unit hdr}
  1532.     S := AddrStub(D);               {point to our stub    }
  1533.     R := FormLL(U,S);               {get offset to stub   }
  1534.     IF (R <> 0) THEN
  1535.     IF (TypeLG.UntID <> R) THEN     {if offsets don't match }
  1536.     REPEAT
  1537.        D := AddrDict(U,S^.sYNU);            {chain to next DE}
  1538.        IF D^.DForm <> 'Y' THEN R := 0 ELSE  {if next is unit }
  1539.        BEGIN
  1540.          S := AddrStub(D);                  {its stub address}
  1541.          R := FormLL(U,S);                  {and stub offset }
  1542.        END;
  1543.     UNTIL (R = TypeLG.UntID) OR (R = 0);    {match of end list  }
  1544.     IF R <> 0 THEN AddrLGUnit := D          {we had a match     }
  1545.               ELSE AddrLGUnit := Nil;       {we couldn't find it}
  1546. END;
  1547.  
  1548.   { Function Below Gets Pointer to Procedure Stub Type Descriptor }{.CP07}
  1549.  
  1550. FUNCTION  AddrProcType(S: DStubPtr): TypePtr;
  1551. BEGIN
  1552.    If S = Nil Then AddrProcType := Nil Else
  1553.    AddrProcType := TypePtr(PtrAdjust(@S^.sSVM,SizeOf(S^.sSVM)))
  1554. END;
  1555.  
  1556.   { Function Below Gets Pointer to Next Entry in Source File List } {.CP21}
  1557.  
  1558. FUNCTION  AddrNxtSrc(U: UnitPtr; Arg: SrcFilePtr): SrcFilePtr;
  1559. VAR J: LL;  S: SrcFilePtr;
  1560. BEGIN
  1561.     J := 0;
  1562.     IF (U = Nil) OR (Arg = Nil) THEN AddrNxtSrc := Nil ELSE
  1563.     BEGIN
  1564.        J := FormLL(U,Arg);
  1565.        IF J < U^.UHLSF
  1566.        THEN AddrNxtSrc := Nil ELSE
  1567.        IF NOT (J < U^.UHDBT)
  1568.        THEN AddrNxtSrc := Nil ELSE
  1569.        BEGIN
  1570.           S := SrcFilePtr(PtrAdjust(Arg,8 + Ord(Arg^.SrcName[0])));
  1571.           IF FormLL(U,S) < U^.UHDBT
  1572.           THEN AddrNxtSrc := S
  1573.           ELSE AddrNxtSrc := Nil
  1574.        END
  1575.     END
  1576. END;
  1577.  
  1578.   { Function Below Gets Pointer to Source File List Entry at Offset }{.CP09}
  1579.  
  1580. FUNCTION  AddrSrcTabOff(U: UnitPtr; Offset: Word): SrcFilePtr;
  1581. BEGIN
  1582.    AddrSrcTabOff := Nil;
  1583.    If U <> Nil Then WITH U^ DO
  1584.    IF (UHLSF+Offset) < UHDBT
  1585.    THEN AddrSrcTabOff := SrcFilePtr(PtrAdjust(U,UHLSF+Offset));
  1586. END;
  1587.  
  1588.   { Function Below Gets Pointer to Next Entry in DLL List }    {.CP21}
  1589.  
  1590. FUNCTION  AddrNxtDLL(U: UnitPtr; Arg: DLLPtr): DLLPtr;
  1591. VAR J: LL;  S: DLLPtr;
  1592. BEGIN
  1593.     J := 0;
  1594.     IF (U = Nil) OR (Arg = Nil) THEN AddrNxtDLL := Nil ELSE
  1595.     BEGIN
  1596.        J := FormLL(U,Arg);
  1597.        IF J < U^.UHDLL
  1598.        THEN AddrNxtDLL := Nil ELSE
  1599.        IF NOT (J < U^.UHLDU)
  1600.        THEN AddrNxtDLL := Nil ELSE
  1601.        BEGIN
  1602.           S := DLLPtr(PtrAdjust(Arg,5 + Ord(Arg^.DLLMod[0])));
  1603.           IF FormLL(U,S) < U^.UHLDU
  1604.           THEN AddrNxtDLL := S
  1605.           ELSE AddrNxtDLL := Nil
  1606.        END
  1607.     END
  1608. END;
  1609.  
  1610.   { Function Below Gets Pointer to DLL List Entry at Offset }    {.CP09}
  1611.  
  1612. FUNCTION  AddrDLLTabOff(U: UnitPtr; Offset: Word): DLLPtr;
  1613. BEGIN
  1614.    AddrDLLTabOff := Nil;
  1615.    If U <> Nil Then WITH U^ DO
  1616.    IF (UHDLL+Offset) < UHLDU
  1617.    THEN AddrDLLTabOff := DLLPtr(PtrAdjust(U,UHDLL+Offset));
  1618. END;
  1619.  
  1620.   { Function Counts Number of Slots in PROC Map Table }        {.CP06}
  1621.  
  1622. FUNCTION  CountPMapSlots(U: UnitPtr): Integer;
  1623. BEGIN
  1624.     CountPMapSlots := (U^.UHCMT-U^.UHPMT) DIV SizeOf(PMapRec);
  1625. END;
  1626.  
  1627.   { Function Gets Address of PROC Map Table }            {.CP08}
  1628.  
  1629. FUNCTION  AddrPMapTab(U: UnitPtr): PMapPtr;
  1630. BEGIN
  1631.     IF CountPMapSlots(U) > 0
  1632.     THEN AddrPMapTab := PMapPtr(PtrAdjust(U,U^.UHPMT))
  1633.     ELSE AddrPMapTab := Nil
  1634. END;
  1635.  
  1636.   { Function Counts Number of Slots in CSeg Map Table }        {.CP06}
  1637.  
  1638. FUNCTION  CountCMapSlots(U: UnitPtr): Integer;
  1639. BEGIN
  1640.     WITH U^ DO CountCMapSlots := (UHTMT-UHCMT) DIV SizeOf(CMapRec);
  1641. END;
  1642.  
  1643.   { Function Gets Address of CSeg Map Table }            {.CP08}
  1644.  
  1645. FUNCTION  AddrCMapTab(U: UnitPtr): CMapTabPtr;
  1646. BEGIN
  1647.     IF CountCmapSlots(U) > 0
  1648.     THEN AddrCMapTab := CMapTabPtr(PtrAdjust(U,U^.UHCMT))
  1649.     ELSE AddrCMapTab := Nil
  1650. END;
  1651.  
  1652.   { Function Counts Number of DSeg Map Slots }            {.CP06}
  1653.  
  1654. FUNCTION  CountDMapSlots(U: UnitPtr): Integer;
  1655. BEGIN
  1656.     WITH U^ DO CountDMapSlots := (UHDMT - UHTMT) DIV SizeOf(DMapRec)
  1657. END;
  1658.  
  1659.   { Function Gets Address of DSeg Map Table }            {.CP08}
  1660.  
  1661. FUNCTION  AddrDMapTab(U: UnitPtr): DMapTabPtr;
  1662. BEGIN
  1663.     IF CountDMapSlots(U) > 0
  1664.     THEN AddrDMapTab := DMapTabPtr(PtrAdjust(U,U^.UHTMT))
  1665.     ELSE AddrDMapTab := Nil
  1666. END;
  1667.  
  1668.   { Function Below Gets Pointer to 1st Trace Table Entry or Nil }  {.CP08}
  1669.  
  1670. FUNCTION  AddrTraceTab(U: UnitPtr): TraceRecPtr;
  1671. BEGIN
  1672.     IF U^.UHDBT = U^.UHZDA
  1673.     THEN AddrTraceTab := Nil
  1674.     ELSE AddrTraceTab := TraceRecPtr(PtrAdjust(U,U^.UHDBT))
  1675. END; {AddrTraceTab}
  1676.  
  1677.    { Function Below Gets Byte Count in TrExec Array }        {.CP20}
  1678.  
  1679. FUNCTION GetTrExecSize(T: TraceRecPtr): Integer;
  1680. VAR i,k : Integer;
  1681. BEGIN
  1682.    IF T = Nil THEN GetTrExecSize := 0 ELSE
  1683.    BEGIN
  1684.       k := T^.TrLNos;                   {number of lines in array}
  1685.       i := 1;                           {prime scan line number  }
  1686.       WHILE i <= k DO BEGIN             {still have lines to test}
  1687.          IF T^.TrExec[i] = $80 THEN     {if "escape byte" present}
  1688.      BEGIN
  1689.        Inc(k);                      {bump array limit        }
  1690.        Inc(i)                       {bump to byte count slot }
  1691.      END;
  1692.      Inc(i)                         {check next slot         }
  1693.       END;
  1694.       GetTrExecSize := k;               {final byte count        }
  1695.    END;
  1696. END;
  1697.  
  1698.   { Function Below Gets Pointer to next Trace Table Entry or Nil }  {.CP14}
  1699.  
  1700. FUNCTION  AddrNxtTrace(U: UnitPtr; T: TraceRecPtr): TraceRecPtr;
  1701. VAR k : Integer;
  1702. BEGIN
  1703.     IF T = Nil THEN AddrNxtTrace := Nil ELSE
  1704.     BEGIN
  1705.         k := GetTrExecSize(T);
  1706.         T := TraceRecPtr(PtrAdjust(@T^.TrExec[1],LL(k)));
  1707.         IF FormLL(U,T) >= U^.UHZDA
  1708.             THEN AddrNxtTrace := Nil
  1709.             ELSE AddrNxtTrace := T
  1710.     END
  1711. END; {AddrNxtTrace}
  1712.  
  1713.   { Function Below Gets Pointer to 1st Fixup Table Entry or Nil }  {.CP17}
  1714.  
  1715. Type FixClass = (CodeFix, DataFix);
  1716.  
  1717. FUNCTION  AddrFixUps(U: UnitPtr; C: FixClass): FixUpPtr;
  1718. VAR j : Word; S: TUnitPtr;
  1719. BEGIN
  1720.     S := FindCover(U);
  1721.         If S <> Nil Then
  1722.     Begin
  1723.            Case C Of
  1724.              CodeFix: AddrFixUps := FixUpPtr(S^.UFXC);
  1725.              DataFix: AddrFixUps := FixUpPtr(S^.UFXD);
  1726.              Else     AddrFixUps := Nil;
  1727.            End
  1728.     End  Else     AddrFixUps := Nil;
  1729. END; {AddrFixUps}
  1730.  
  1731. Function AddrCodeFixUps(U: UnitPtr): FixUpPtr;            {.CP02}
  1732. Begin    AddrCodeFixUps := AddrFixUps(U,CodeFix); End;
  1733.  
  1734. Function AddrDataFixUps(U: UnitPtr): FixUpPtr;            {.CP02}
  1735. Begin    AddrDataFixUps := AddrFixUps(U,DataFix); End;
  1736.  
  1737. Function AddrCodeArea(U: UnitPtr): Pointer;            {.CP06}
  1738. Var S: TUnitPtr;
  1739. Begin
  1740.     S := FindCover(U);
  1741.     If S <> Nil Then AddrCodeArea := S^.UCod Else AddrCodeArea := Nil
  1742. End;
  1743.  
  1744. Function AddrDataArea(U: UnitPtr): Pointer;            {.CP06}
  1745. Var S: TUnitPtr;
  1746. Begin
  1747.     S := FindCover(U);
  1748.     If S <> Nil Then AddrDataArea := S^.UDta Else AddrDataArea := Nil
  1749. End;
  1750.  
  1751. PROCEDURE SortProcRefs(Mode: SortMode);                {.CP06}
  1752. Begin
  1753.    If LstRoot <> Nil Then
  1754.    If LstRoot^.CvrRMaps[rPROC] <> Nil
  1755.    Then LstRoot^.CvrRMaps[rPROC]^.SortPmap(Mode);
  1756. End;
  1757.  
  1758. PROCEDURE FetchMapRef  (VAR S : MapRefRec;            {.CP10}
  1759.               C   : MapClass;
  1760.             Offset: Word);
  1761. Var Q : TUnitPtr;
  1762. Begin
  1763.    Q := LstRoot; S := NullMap;
  1764.    If Q <> Nil Then
  1765.    If Q^.CvrRMaps[C] <> Nil
  1766.    Then Q^.CvrRMaps[C]^.FetchRef(S,Offset);
  1767. End;
  1768.  
  1769. PROCEDURE FetchSurveyRec (VAR S : SurveyRec);            {.CP18}
  1770. Var Q : CvrRec;
  1771. Begin
  1772.    S.LocTyp := cvNULL; S.LocLL  := 0; S.LocOwn := 0; S.LocNxt := 0;
  1773.    If LstRoot <> Nil Then With LstRoot^ Do
  1774.    If UImg <> Nil    Then If CvrQue <> Nil Then
  1775.    Begin
  1776.       If CvrQueHead < CvrQueTail Then
  1777.       Begin
  1778.          Inc(CvrQueHead);
  1779.          Q := CvrQue^[CvrQueHead];
  1780.          S.LocTyp := Q.LocTyp; S.LocLL  := Q.LocLL;
  1781.          S.LocOwn := Q.LocOwn; S.LocNxt := UImg^.UHPMT
  1782.       End;
  1783.       If CvrQueHead < CvrQueTail
  1784.       Then S.LocNxt := CvrQue^[CvrQueHead+1].LocLL;
  1785.    End;
  1786. End; {FetchSurveyRec}
  1787.  
  1788. Procedure PurgeAllUnits;                    {.CP12}
  1789. Var P, Q: TUnitPtr;
  1790. Begin
  1791.    P := Nil; Q := LstRoot;
  1792.    While Q <> Nil Do
  1793.    Begin
  1794.       P := Q^.Link;
  1795.       Q^.Done;
  1796.       Q := P;
  1797.    End;
  1798.    LstRoot := Nil;
  1799. End; {PurgeAllUnits}
  1800.  
  1801. Function FindUnit(N: _UnitName) : UnitPtr;            {.CP12}
  1802. Var P : TUnitPtr; U : UnitPtr;
  1803. Begin
  1804.    U := Nil; P := LstRoot;
  1805.    While P <> Nil Do
  1806.       If P^.Name <> N Then P := P^.Link Else
  1807.       Begin
  1808.          U := P^.UImg;
  1809.          P := Nil
  1810.       End;
  1811.    FindUnit := U;
  1812. End;
  1813.  
  1814. PROCEDURE SurveyUnit(U : UnitPtr);                {.CP11}
  1815. Var S : TUnitPtr;
  1816. BEGIN  {SurveyUnit}
  1817.    S := FindCover(U);        { Locate Proper TUnit     }
  1818.    If S <> Nil Then
  1819.    Begin
  1820.     S^.CalcCovers;        { Analyze Dictionary      }
  1821.     If S = LstRoot Then    { If Initial Unit Then    }
  1822.        S^.IndexMaps;    { Cross-Index All Maps    }
  1823.    End;
  1824. END;   {SurveyUnit}
  1825.  
  1826. PROCEDURE ResolveLG(N: _UnitName; L: LG; VAR R: RespLG);    {.CP19}
  1827. Var S : RespLG; U : UnitPtr; T : TUnitPtr; Q: CvrPtr;
  1828.     W : Word;
  1829. Begin
  1830.    S.Uptr := Nil; S.Ownr := $FFFF; U := FindUnit(N);
  1831.    If U <> Nil Then
  1832.    Begin
  1833.       T := FindCover(U);
  1834.       W := T^.QueuePos(L.UntLL);
  1835.       Q := T^.CvrQue;
  1836.       If NOT (W > T^.CvrQueTail) Then
  1837.       If L.UntLL = Q^[W].LocLL Then
  1838.       Begin
  1839.          S.Uptr := U;
  1840.      S.Ownr := Q^[W].LocOwn;
  1841.       End;
  1842.    End;
  1843.    R := S;
  1844. End;  { ResolveLG }
  1845.  
  1846. Var LoaderPath: _FileXpnd;
  1847.  
  1848. Procedure UnitLoader(    Path : Dos.PathStr;            {.CP12}
  1849.             Name : _UnitName;
  1850.             Optn : UnitMode;
  1851.             VAR Core : Word;
  1852.             VAR Locn : UnitPtr);
  1853. VAR  SaveMode,UnitVersion : Word;    U : UnitPtr;
  1854.      FileId   : _FileSpec;
  1855.      FileDir  : Dos.DirStr;    FileName : Dos.NameStr;
  1856.      FileExtn : Dos.ExtStr;    FilePath : Dos.PathStr;
  1857.      WorkArea : Array[0..3] Of _Paragraph;
  1858.      UnitFile : File;        EnvirPth : String;
  1859.      Z : LdrVec;
  1860.  
  1861.      Function UnitSize( U : UnitPtr) : LongInt;            {.CP25}
  1862.      VAR EyeBall : String[4]; I : Byte; Total : LongInt;
  1863.      Begin
  1864.         For I := 1 To 5 Do Begin
  1865.       Z[I].LdrUpt := Nil; Z[I].LdrSiz := 0;
  1866.         End;
  1867.         Total := 0;
  1868.         EyeBall[0] := Chr(SizeOf(EyeBall)-1);
  1869.         Move(U^,EyeBall[1],SizeOf(EyeBall)-1);
  1870.         If EyeBall = _UnitEye Then
  1871.     Begin
  1872.        Z[1].LdrSiz := (U^.UHZDA+$F) AND $FFF0; { ENTIRE Dictionary Size }
  1873.            Z[2].LdrSiz := (U^.UHZCS+$F) AND $FFF0; { Size: All CSegs         }
  1874.            Z[3].LdrSiz := (U^.UHZDT+$F) AND $FFF0; { Size: All Typed CONSTS }
  1875.            Z[4].LdrSiz := (U^.UHZFA+$F) AND $FFF0; { Size: All CSeg Fix-Ups }
  1876.            Z[5].LdrSiz := (U^.UHZFT+$F) AND $FFF0; { Size: All CONS Fix-Ups }
  1877.            For I := 1 To 5 Do Inc(Total,Z[I].LdrSiz);    { Calc Unit Size }
  1878.            If Optn = Partial Then
  1879.        Begin
  1880.           Z[1].LdrSiz := (U^.UHPMT+$F) AND $FFF0 ;    { Dictionary Size   }
  1881.               For I := 2 To 5 Do Z[I].LdrSiz := 0;     { Skip rest of unit }
  1882.            End;
  1883.         End;
  1884.         UnitSize := Total;        { Return Total Actual Size of Unit }
  1885.      End; {UnitSize}
  1886.  
  1887.      Function FileExists( N : _FileSpec) : Boolean;        {.CP12}
  1888.      Begin
  1889.         FilePath := FSearch(N,EnvirPth);
  1890.         If FilePath <> '' Then
  1891.         Begin
  1892.            FilePath := FExpand(FilePath);
  1893.            FSplit(FilePath,FileDir,FileName,FileExtn);
  1894.            FileId := N;
  1895.            FileExists := True
  1896.         End
  1897.         Else FileExists := False;
  1898.      End; {FileExists}
  1899.  
  1900.      Procedure OpenUnitFile(P : Dos.PathStr; N : _FileSpec);    {.CP08}
  1901.      Begin
  1902.         Assign(UnitFile,P+N);
  1903.         SaveMode := FileMode;
  1904.         FileMode := 0;
  1905.         Reset(UnitFile,SizeOf(_Paragraph));
  1906.         FileMode := SaveMode;
  1907.      End;
  1908.  
  1909.      Procedure InstallUnit(Z: LdrVec; N : _UnitName);        {.CP18}
  1910.      Var Sk, Sr : Word; T, V : TUnitPtr;
  1911.      Begin
  1912.         T := New(TUnitPtr,Init(N,Z));            { build placeholder }
  1913.         If T <> Nil Then
  1914.         Begin
  1915.            If LstRoot = Nil
  1916.            Then LstRoot := T Else            { add to chain        }
  1917.            Begin
  1918.               V := LstRoot;
  1919.               While V^.Link <> Nil Do V := V^.Link;
  1920.               V^.Link := T;
  1921.            End;
  1922.            LoaderPath := FileDir+FileId;
  1923.            Core := Sk;             { Say How Much of Unit Loaded }
  1924.            Locn := T^.UImg;        { Point to Unit Load Address  }
  1925.         End;
  1926.      End; {InstallUnit}
  1927.  
  1928. Procedure CheckLibrary(N: _UnitName);                {.CP17}
  1929. Var I: Word; Su, Sf, Fp, Tp: LongInt;
  1930.     U: UnitPtr; Ps: DStubPtr; Pn: DNamePtr; U1: Pointer;
  1931.  
  1932.     Function FetchUnitSegment(Posn: LongInt; BytCnt: Word): Pointer;
  1933.     Var Pf : Pointer;
  1934.     Begin
  1935.         Pf := Nil;
  1936.         If (Sf > 0) AND (BytCnt > 0) Then
  1937.         Begin
  1938.            Seek(UnitFile,Posn);
  1939.            GetMem(Pf,BytCnt);
  1940.            If Pf <> Nil
  1941.        Then BLockRead(UnitFile,Pf^,BytCnt SHR 4);
  1942.         End;
  1943.         FetchUnitSegment := Pf;
  1944.     End;
  1945. Begin {CheckLibrary}                        {.CP43}
  1946.     OpenUnitFile(FileDir,FileId);    { Open the File     }
  1947.     Sf := FileSize(UnitFile);        { Get File Size (rcds)    }
  1948.     Fp := 0;                { File Pointer = 0    }
  1949.     While Fp < Sf Do Begin        { Browse the Library    }
  1950.  
  1951.         Seek(UnitFile,Fp);                  { Locate Unit    }
  1952.         BlockRead(UnitFile,WorkArea,4);        { Read Header    }
  1953.         U := @WorkArea;                { Point to it    }
  1954.         Su := UnitSize(U);        { Get Unit Size - Bytes }
  1955.         If Su > 0 Then                { If Unit <> Nil}
  1956.     Begin
  1957.             Z[1].LdrUpt := FetchUnitSegment(Fp,Z[1].LdrSiz);
  1958.             If Z[1].LdrUpt <> Nil Then
  1959.             Begin
  1960.            Tp := Z[1].LdrSiz SHR 4 + Fp;
  1961.                U  := UnitPtr(Z[1].LdrUpt);
  1962.  
  1963.                Pn := DNamePtr(Ptr(Seg(U^),Ofs(U^)+U^.UHUDH));
  1964.                Ps := AddrStub(Pn);
  1965.  
  1966.                { Check name for match, if nested check for version match }
  1967.  
  1968.                If (N <> Pn^.DSymb) OR
  1969.                   ((Optn = Partial) AND (Ps^.sYCS <> UnitVersion)) Then
  1970.                Begin
  1971.                   FreeMem(U,Z[1].LdrSiz);    { Wrong Unit / Version }
  1972.                   Inc(Fp,Su SHR 4);
  1973.                End Else
  1974.                Begin                { load remaining segments }
  1975.                   For I := 2 To 5 Do Begin
  1976.                      U := FetchUnitSegment(Tp,Z[I].LdrSiz);
  1977.                      If U <> Nil Then Tp := Z[I].LdrSiz SHR 4 + Tp;
  1978.                      If U <> Nil Then Z[I].LdrUpt := U;
  1979.                   End;
  1980.                   InstallUnit(Z,N);
  1981.                   Fp := Sf        { terminates browse process }
  1982.                End;
  1983.             End
  1984.         End Else Fp := Sf;        { skip out if invalid unit  }
  1985.     End;
  1986.     Close(UnitFile);
  1987. End; {CheckLibrary}
  1988.  
  1989. VAR  I : Word;                            {.CP12}
  1990. Begin {UnitLoader}
  1991.    UnitVersion := Core;
  1992.    Core := 0;
  1993.    Locn := Nil;
  1994.    LoaderPath := '';
  1995.    If Path = ''
  1996.      Then EnvirPth := GetEnv('PATH')
  1997.      Else EnvirPth := Path;
  1998.    If FileExists(Name+'.TPU')    Then CheckLibrary(Name) Else
  1999.    If FileExists(_Lib_Nam)    Then CheckLibrary(Name);
  2000. End;  {UnitLoader}
  2001.  
  2002. Function AnalyzeUnit(Name: _UnitName; Path: String): UnitPtr;    {.CP36}
  2003.  
  2004. Var U, Z: UnitPtr; N: DNamePtr; S: DStubPtr; USize: Word;
  2005. Begin
  2006.    UnitLoader(Path,Name,Entire,USize,U);    { Load Entire  Unit }
  2007.    AnalyzeUnit := U;                { Save Unit Pointer }
  2008.    If U <> Nil Then
  2009.    Begin
  2010.       PutTxt('Unit ('+Name+')');
  2011.       SetCol(17);
  2012.       PutTxt(' loaded from '+LoaderPath);
  2013.       SetCol(1);
  2014.       SurveyUnit(U);                { Analyze Unit }
  2015.       Base_Code   := (U^.UHZDA + $F) AND Masker;
  2016.       Base_Data   := (U^.UHZCS + $F) AND Masker + Base_Code;
  2017.       Base_FixC   := (U^.UHZDT + $F) AND Masker + Base_Data;
  2018.       Base_FixD   := (U^.UHZFA + $F) AND Masker + Base_FixC;
  2019.       N := DNamePtr(PtrAdjust(U,U^.UHUDH));    { Point to its name }
  2020.       S := AddrStub(N);                { Point to its stub }
  2021.       While S^.sYNU <> 0 Do            { if successor unit }
  2022.       Begin
  2023.          N := DNamePtr(PtrAdjust(U,S^.sYNU));        { Point to Name }
  2024.          S := AddrStub(N);                { Point to Stub }
  2025.          USize := S^.sYCS;                { Load Version  }
  2026.          UnitLoader(Path,N^.DSymb,Partial,USize,Z); { Load Partial  }
  2027.          If Z <> Nil Then
  2028.      Begin
  2029.         PutTxt('Unit ('+N^.DSymb+')');
  2030.         SetCol(17);
  2031.         PutTxt(' loaded from '+LoaderPath);
  2032.             SetCol(1);
  2033.         SurveyUnit(Z);            { Get its Cover }
  2034.          End;
  2035.       End;                { Until all Units Handled }
  2036.    End;
  2037. End; {AnalyzeUnit}
  2038.  
  2039. {$IFDEF TESTDBG}                        {.CP07}
  2040. Begin
  2041.    ExitSave := ExitProc;
  2042.    ExitProc := @MyExit;
  2043.    Assign(Audit,'Audit.Lst');
  2044. {$ENDIF}
  2045. END.